Browse Source

* Added Makefiles
* added FV specific units and objects from old FV

peter 24 years ago
parent
commit
c552369bd1

+ 1057 - 0
fv/Makefile

@@ -0,0 +1,1057 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override PACKAGE_NAME=fv
+override PACKAGE_VERSION=1.0.5
+override TARGET_UNITS+=buildfv
+override TARGET_EXAMPLEDIRS+=test
+override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_FPCPACKAGE=y
+override COMPILER_TARGETDIR+=.
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+.PHONY: package_rtl
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifdef TARGET_UNITS
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+endif
+fpc_units: $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_examples
+ifdef TARGET_EXAMPLES
+HASEXAMPLES=1
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
+override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
+override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
+override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+endif
+ifdef TARGET_EXAMPLEDIRS
+HASEXAMPLES=1
+endif
+fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(ZIPPREFIX)$(PACKAGE_NAME)$(ZIPSUFFIX)
+endif
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(BATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=src
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=exm
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+TARGET_EXAMPLEDIRS_TEST=1
+ifdef TARGET_EXAMPLEDIRS_TEST
+test_all:
+	$(MAKE) -C test all
+test_debug:
+	$(MAKE) -C test debug
+test_smart:
+	$(MAKE) -C test smart
+test_examples:
+	$(MAKE) -C test examples
+test_shared:
+	$(MAKE) -C test shared
+test_install:
+	$(MAKE) -C test install
+test_sourceinstall:
+	$(MAKE) -C test sourceinstall
+test_exampleinstall:
+	$(MAKE) -C test exampleinstall
+test_distinstall:
+	$(MAKE) -C test distinstall
+test_zipinstall:
+	$(MAKE) -C test zipinstall
+test_zipsourceinstall:
+	$(MAKE) -C test zipsourceinstall
+test_zipexampleinstall:
+	$(MAKE) -C test zipexampleinstall
+test_zipdistinstall:
+	$(MAKE) -C test zipdistinstall
+test_clean:
+	$(MAKE) -C test clean
+test_distclean:
+	$(MAKE) -C test distclean
+test_cleanall:
+	$(MAKE) -C test cleanall
+test_info:
+	$(MAKE) -C test info
+test:
+	$(MAKE) -C test all
+.PHONY: test_all test_debug test_smart test_examples test_shared test_install test_sourceinstall test_exampleinstall test_distinstall test_zipinstall test_zipsourceinstall test_zipexampleinstall test_zipdistinstall test_clean test_distclean test_cleanall test_info test
+endif
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples: fpc_examples
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean $(addsuffix _clean,$(TARGET_EXAMPLEDIRS))
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 31 - 0
fv/Makefile.fpc

@@ -0,0 +1,31 @@
+#
+#   Makefile.fpc for Free Vision for Free Pascal
+#
+
+[package]
+name=fv
+version=1.0.5
+
+[target]
+units=buildfv
+exampledirs=test
+
+[libs]
+libname=libfpfv.so
+libversion=1.0
+
+[compiler]
+targetdir=.
+
+[install]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+fpcpackage=y
+
+[clean]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+
+[default]
+fpcdir=..
+
+[rules]
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 6 - 2
fv/app.pas

@@ -57,7 +57,7 @@ USES
    {$ENDIF}
    {$ENDIF}
 
 
    GFVGraph,                                          { GFV standard unit }
    GFVGraph,                                          { GFV standard unit }
-   Common, Memory,                                    { GFV standard units }
+   FVCommon, Memory,                                    { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
@@ -1088,7 +1088,11 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.11  2001-05-31 21:39:11  pierre
+ Revision 1.12  2001-08-04 19:14:32  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.11  2001/05/31 21:39:11  pierre
   + AltF12 to force Redraw of Application
   + AltF12 to force Redraw of Application
 
 
  Revision 1.10  2001/05/31 12:15:24  pierre
  Revision 1.10  2001/05/31 12:15:24  pierre

+ 42 - 0
fv/buildfv.pas

@@ -0,0 +1,42 @@
+{
+  $Id$
+
+  Unit to build all units of Free Vision
+}
+unit buildfv;
+interface
+uses
+  fvcommon,
+  objects,
+  drivers,
+  fileio,
+  memory,
+  gfvgraph,
+
+  fvconsts,
+  resource,
+  views,
+  validate,
+  msgbox,
+  dialogs,
+  menus,
+  app,
+  stddlg,
+
+  tabs,
+  statuses,
+  histlist,
+  inplong,
+  gadgets,
+  time;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:32  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

File diff suppressed because it is too large
+ 630 - 71
fv/dialogs.pas


+ 73 - 69
fv/drivers.pas

@@ -78,7 +78,7 @@ USES
 
 
    video,
    video,
    GFVGraph,                                          { GFV graphics unit }
    GFVGraph,                                          { GFV graphics unit }
-   Common, Objects;                                   { GFV standard units }
+   FVCommon, Objects;                                 { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
 {                              PUBLIC CONSTANTS                             }
@@ -231,28 +231,28 @@ CONST
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 TYPE
 TYPE
    TEvent = PACKED RECORD
    TEvent = PACKED RECORD
-      What: Word;                                     { Event type }
-      Case Word Of
+      What: Sw_Word;                                     { Event type }
+      Case Sw_Word Of
         evNothing: ();                                { ** NO EVENT ** }
         evNothing: ();                                { ** NO EVENT ** }
         evMouse: (
         evMouse: (
           Buttons: Byte;                              { Mouse buttons }
           Buttons: Byte;                              { Mouse buttons }
           Double: Boolean;                            { Double click state }
           Double: Boolean;                            { Double click state }
           Where: TPoint);                             { Mouse position }
           Where: TPoint);                             { Mouse position }
         evKeyDown: (                                  { ** KEY EVENT ** }
         evKeyDown: (                                  { ** KEY EVENT ** }
-          Case Integer Of
-            0: (KeyCode: Word);                       { Full key code }
+          Case Sw_Integer Of
+            0: (KeyCode: Sw_Word);                       { Full key code }
             1: (CharCode: Char;                       { Char code }
             1: (CharCode: Char;                       { Char code }
                 ScanCode: Byte;                       { Scan code }
                 ScanCode: Byte;                       { Scan code }
                 KeyShift: byte));                     { Shift states }
                 KeyShift: byte));                     { Shift states }
         evMessage: (                                  { ** MESSAGE EVENT ** }
         evMessage: (                                  { ** MESSAGE EVENT ** }
-          Command: Word;                              { Message command }
-          Id     : Word;                              { Message id }
+          Command: Sw_Word;                              { Message command }
+          Id     : Sw_Word;                              { Message id }
           Data   : Real;                              { Message data }
           Data   : Real;                              { Message data }
-          Case Word Of
+          Case Sw_Word Of
             0: (InfoPtr: Pointer);                    { Message pointer }
             0: (InfoPtr: Pointer);                    { Message pointer }
             1: (InfoLong: Longint);                   { Message longint }
             1: (InfoLong: Longint);                   { Message longint }
-            2: (InfoWord: Word);                      { Message word }
-            3: (InfoInt: Integer);                    { Message integer }
+            2: (InfoWord: Word);                      { Message Sw_Word }
+            3: (InfoInt: Integer);                    { Message Sw_Integer }
             4: (InfoByte: Byte);                      { Message byte }
             4: (InfoByte: Byte);                      { Message byte }
             5: (InfoChar: Char));                     { Message character }
             5: (InfoChar: Char));                     { Message character }
    END;
    END;
@@ -262,7 +262,7 @@ TYPE
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 TYPE
 TYPE
-   TSysErrorFunc = FUNCTION (ErrorCode: Integer; Drive: Byte): Integer;
+   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -283,13 +283,13 @@ the screen. For example, given the string '~B~roccoli' as its
 parameter, CStrLen returns 8.
 parameter, CStrLen returns 8.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
 
 
 {-MoveStr------------------------------------------------------------
 {-MoveStr------------------------------------------------------------
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
-Dest must be a TDrawBuffer (or an equivalent array of words). The
-characters in Str are moved into the low bytes of corresponding words
-in Dest. The high bytes of the words are set to Attr, or remain
+Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
+characters in Str are moved into the low bytes of corresponding Sw_Words
+in Dest. The high bytes of the Sw_Words are set to Attr, or remain
 unchanged if Attr is zero.
 unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
@@ -297,30 +297,30 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
 
 {-MoveCStr-----------------------------------------------------------
 {-MoveCStr-----------------------------------------------------------
 The characters in Str are moved into the low bytes of corresponding
 The characters in Str are moved into the low bytes of corresponding
-words in Dest. The high bytes of the words are set to Lo(Attr) or
+Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
 Hi(Attr). Tilde characters (~) in the string toggle between the two
 Hi(Attr). Tilde characters (~) in the string toggle between the two
-attribute bytes passed in the Attr word.
+attribute bytes passed in the Attr Sw_Word.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
 
 {-MoveBuf------------------------------------------------------------
 {-MoveBuf------------------------------------------------------------
 Count bytes are moved from Source into the low bytes of corresponding
 Count bytes are moved from Source into the low bytes of corresponding
-words in Dest. The high bytes of the words in Dest are set to Attr,
+Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
 or remain unchanged if Attr is zero.
 or remain unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
 
 {-MoveChar------------------------------------------------------------
 {-MoveChar------------------------------------------------------------
 Moves characters into a buffer for use with a view's WriteBuf or
 Moves characters into a buffer for use with a view's WriteBuf or
-WriteLine. Dest must be a TDrawBuffer (or an equivalent array of words).
-The low bytes of the first Count words of Dest are set to C, or
-remain unchanged if Ord(C) is zero. The high bytes of the words are
+WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
+The low bytes of the first Count Sw_Words of Dest are set to C, or
+remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
 set to Attr, or remain unchanged if Attr is zero.
 set to Attr, or remain unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                        KEYBOARD SUPPORT ROUTINES                          }
 {                        KEYBOARD SUPPORT ROUTINES                          }
@@ -351,7 +351,7 @@ Returns the ascii character for the Ctrl+Key scancode that was given.
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
 
 {-CtrlToArrow--------------------------------------------------------
 {-CtrlToArrow--------------------------------------------------------
-Converts a WordStar-compatible control key code to the corresponding
+Converts a Sw_WordStar-compatible control key code to the corresponding
 cursor key code.
 cursor key code.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
@@ -449,7 +449,7 @@ PROCEDURE ClearScreen;
 Does nothing provided for compatability purposes only.
 Does nothing provided for compatability purposes only.
 04Jan97 LdB
 04Jan97 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           ERROR CONTROL ROUTINES                          }
 {                           ERROR CONTROL ROUTINES                          }
@@ -473,7 +473,7 @@ PROCEDURE DoneSysError;
 Error handling is not yet implemented so this simply drops through.
 Error handling is not yet implemented so this simply drops through.
 20May98 LdB
 20May98 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           STRING FORMAT ROUTINES                          }
 {                           STRING FORMAT ROUTINES                          }
@@ -532,25 +532,25 @@ CONST
    SysErrActive : Boolean = False;                    { Compatability only }
    SysErrActive : Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    ButtonCount  : Byte = 0;                           { Mouse button count }
    ButtonCount  : Byte = 0;                           { Mouse button count }
-   DoubleDelay  : Word = 8;                           { Double click delay }
-   RepeatDelay  : Word = 8;                           { Auto mouse delay }
-   SysColorAttr : Word = $4E4F;                       { System colour attr }
-   SysMonoAttr  : Word = $7070;                       { System mono attr }
-   StartupMode  : Word = $FFFF;                       { Compatability only }
-   CursorLines  : Word = $FFFF;                       { Compatability only }
+   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
+   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
+   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
+   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
+   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
+   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
-   SysErrorFunc : TSysErrorFunc = SystemError;        { System error ptr }
+   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }
 
 
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 CONST
 CONST
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
-   DefLineNum     : Integer = 25;                     { Default line number }
-   DefFontHeight  : Integer = 0;                      { Default font height }
-   SysFontWidth   : Integer = 8;                      { System font width }
-   SysFontHeight  : Integer = 16;                     { System font height }
+   DefLineNum     : Sw_Integer = 25;                     { Default line number }
+   DefFontHeight  : Sw_Integer = 0;                      { Default font height }
+   SysFontWidth   : Sw_Integer = 8;                      { System font width }
+   SysFontHeight  : Sw_Integer = 16;                     { System font height }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
@@ -565,7 +565,7 @@ VAR
    ScreenWidth : Byte;                                { Screen text width }
    ScreenWidth : Byte;                                { Screen text width }
    ScreenHeight: Byte;                                { Screen text height }
    ScreenHeight: Byte;                                { Screen text height }
 {$ifdef GRAPH_API}
 {$ifdef GRAPH_API}
-   ScreenMode  : Word;                                { Screen mode }
+   ScreenMode  : Sw_Word;                                { Screen mode }
 {$else not GRAPH_API}
 {$else not GRAPH_API}
    ScreenMode  : TVideoMode;                         { Screen mode }
    ScreenMode  : TVideoMode;                         { Screen mode }
 {$endif GRAPH_API}
 {$endif GRAPH_API}
@@ -628,10 +628,10 @@ CONST AltCodes: Array [0..127] Of Byte = (
 {                           NEW CONTROL VARIABLES                           }
 {                           NEW CONTROL VARIABLES                           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 CONST
 CONST
-   HideCount : Integer = 0;                           { Cursor hide count }
-   QueueCount: Word = 0;                              { Queued message count }
-   QueueHead : Word = 0;                              { Queue head pointer }
-   QueueTail : Word = 0;                              { Queue tail pointer }
+   HideCount : Sw_Integer = 0;                           { Cursor hide count }
+   QueueCount: Sw_Word = 0;                              { Queued message count }
+   QueueHead : Sw_Word = 0;                              { Queue head pointer }
+   QueueTail : Sw_Word = 0;                              { Queue tail pointer }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
@@ -644,14 +644,14 @@ VAR
    LastDouble : Boolean;                              { Last double buttons }
    LastDouble : Boolean;                              { Last double buttons }
    LastButtons: Byte;                                 { Last button state }
    LastButtons: Byte;                                 { Last button state }
    DownButtons: Byte;                                 { Last down buttons }
    DownButtons: Byte;                                 { Last down buttons }
-   EventCount : Word;                                 { Events in queue }
-   AutoDelay  : Word;                                 { Delay time count }
-   DownTicks  : Word;                                 { Down key tick count }
-   AutoTicks  : Word;                                 { Held key tick count }
-   LastWhereX : Word;                                 { Last x position }
-   LastWhereY : Word;                                 { Last y position }
-   DownWhereX : Word;                                 { Last x position }
-   DownWhereY : Word;                                 { Last y position }
+   EventCount : Sw_Word;                                 { Events in queue }
+   AutoDelay  : Sw_Word;                                 { Delay time count }
+   DownTicks  : Sw_Word;                                 { Down key tick count }
+   AutoTicks  : Sw_Word;                                 { Held key tick count }
+   LastWhereX : Sw_Word;                                 { Last x position }
+   LastWhereY : Sw_Word;                                 { Last y position }
+   DownWhereX : Sw_Word;                                 { Last x position }
+   DownWhereY : Sw_Word;                                 { Last y position }
    LastWhere  : TPoint;                               { Last mouse position }
    LastWhere  : TPoint;                               { Last mouse position }
    DownWhere  : TPoint;                               { Last down position }
    DownWhere  : TPoint;                               { Last down position }
    EventQHead : Pointer;                              { Head of queue }
    EventQHead : Pointer;                              { Head of queue }
@@ -865,8 +865,8 @@ end;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
-VAR I, J: Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
+VAR I, J: Sw_Integer;
 BEGIN
 BEGIN
    J := 0;                                            { Set result to zero }
    J := 0;                                            { Set result to zero }
    For I := 1 To Length(S) Do
    For I := 1 To Length(S) Do
@@ -881,7 +881,7 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Length(Str) Do Begin                 { For each character }
    For I := 1 To Length(Str) Do Begin                 { For each character }
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
    End;
    End;
@@ -891,12 +891,12 @@ END;
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
-VAR B: Byte; I, J: Word; P: PWord;
+VAR B: Byte; I, J: Sw_Word; P: PWord;
 BEGIN
 BEGIN
    J := 0;                                            { Start position }
    J := 0;                                            { Start position }
    For I := 1 To Length(Str) Do Begin                 { For each character }
    For I := 1 To Length(Str) Do Begin                 { For each character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
-       P := @TWordArray(Dest)[J];                     { Pointer to word }
+       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
        If (Lo(Attrs) <> 0) Then
        If (Lo(Attrs) <> 0) Then
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
@@ -912,11 +912,11 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Count Do Begin
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
    End;
    End;
@@ -925,11 +925,11 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Count Do Begin
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
    End;
    End;
@@ -964,7 +964,7 @@ END;
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 FUNCTION GetAltChar (KeyCode: Word): Char;
 FUNCTION GetAltChar (KeyCode: Word): Char;
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    GetAltChar := #0;                                  { Preset fail return }
    GetAltChar := #0;                                  { Preset fail return }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
@@ -997,10 +997,10 @@ FUNCTION CtrlToArrow (KeyCode: Word): Word;
 CONST NumCodes = 11;
 CONST NumCodes = 11;
       CtrlCodes : Array [0..NumCodes-1] Of Char =
       CtrlCodes : Array [0..NumCodes-1] Of Char =
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
-      ArrowCodes: Array [0..NumCodes-1] Of Word =
+      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
         kbPgUp, kbPgDn, kbBack);
         kbPgUp, kbPgDn, kbBack);
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    CtrlToArrow := KeyCode;                            { Preset key return }
    CtrlToArrow := KeyCode;                            { Preset key return }
    For I := 0 To NumCodes - 1 Do
    For I := 0 To NumCodes - 1 Do
@@ -1029,7 +1029,7 @@ end;
 procedure GetKeyEvent (Var Event: TEvent);
 procedure GetKeyEvent (Var Event: TEvent);
 var
 var
   key      : TKeyEvent;
   key      : TKeyEvent;
-  keycode  : word;
+  keycode  : Word;
   keyshift : byte;
   keyshift : byte;
 begin
 begin
   if Keyboard.PollKeyEvent<>0 then
   if Keyboard.PollKeyEvent<>0 then
@@ -1205,11 +1205,11 @@ END;
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE InitVideo;
 PROCEDURE InitVideo;
-VAR {$ifdef Use_API}I, J: Integer;
+VAR {$ifdef Use_API}I, J: Sw_Integer;
     {$else not Use_API}
     {$else not Use_API}
-    {$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
+    {$IFDEF OS_DOS} I, J: Sw_Integer;Ts: TextSettingsType;{$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
-    {$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
+    {$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
     {$ENDIF}
     {$ENDIF}
 BEGIN
 BEGIN
 {$ifdef GRAPH_API}
 {$ifdef GRAPH_API}
@@ -1271,7 +1271,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 BEGIN
 BEGIN
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
      Else DefLineNum := 24;                           { Normal 24 line mode }
      Else DefLineNum := 24;                           { Normal 24 line mode }
@@ -1300,7 +1300,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 BEGIN
 BEGIN
    If (FailSysErrors = False) Then Begin              { Check error ignore }
    If (FailSysErrors = False) Then Begin              { Check error ignore }
 
 
@@ -1474,7 +1474,11 @@ BEGIN
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.10  2001-05-10 16:46:27  pierre
+ Revision 1.11  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.10  2001/05/10 16:46:27  pierre
   + some improovements made
   + some improovements made
 
 
  Revision 1.9  2001/05/07 22:22:03  pierre
  Revision 1.9  2001/05/07 22:22:03  pierre

+ 24 - 6
fv/fileio.pas

@@ -93,7 +93,7 @@ UNIT FileIO;
 
 
 USES
 USES
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
-  Common;                                             { Standard GFV unit }
+  FVCommon;                                           { Standard GFV unit }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                             PUBLIC CONSTANTS                              }
 {                             PUBLIC CONSTANTS                              }
@@ -154,7 +154,7 @@ access mode the file is opened and the file handle returned. If the
 name or mode is invalid or an error occurs the return will be zero.
 name or mode is invalid or an error occurs the return will be zero.
 27Oct98 LdB
 27Oct98 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 
 
 {-SetFileSize--------------------------------------------------------
 {-SetFileSize--------------------------------------------------------
 The file opened by the handle is set the given size. If the action is
 The file opened by the handle is set the given size. If the action is
@@ -228,7 +228,21 @@ FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Wor
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
-  USES unix;
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
+{$ENDIF}
+
+{$IFDEF OS_FREEBSD}                                   { FREEBSD COMPILER }
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
 {$ENDIF}
 {$ENDIF}
 
 
 {***************************************************************************}
 {***************************************************************************}
@@ -292,7 +306,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    ASSEMBLER;
    ASSEMBLER;
@@ -679,7 +693,11 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.4  2001-05-03 15:55:44  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 15:55:44  pierre
   + linux support for fileio contributed by Holger Schurig
   + linux support for fileio contributed by Holger Schurig
 
 
  Revision 1.3  2001/04/10 21:29:55  pierre
  Revision 1.3  2001/04/10 21:29:55  pierre
@@ -689,4 +707,4 @@ END.
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 430 - 0
fv/fvcommon.pas

@@ -0,0 +1,430 @@
+{ $Id$  }
+{********************[ COMMON UNIT ]***********************}
+{                                                          }
+{    System independent COMMON TYPES & DEFINITIONS         }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                      }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - Speed Pascal 1.0+       (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     12 Jul 97  Bazsi  Initial implementation        }
+{  0.2     18 Jul 97  Bazsi  Linux specific error codes    }
+{  0.2.2   28 Jul 97  Bazsi  Base error code for Video     }
+{  0.2.3   29 Jul 97  Bazsi  Basic types added (PByte etc) }
+{  0.2.5   08 Aug 97  Bazsi  Error handling code added     }
+{  0.2.6   06 Sep 97  Bazsi  Base code for keyboard        }
+{  0.2.7   06 Nov 97  Bazsi  Base error code for filectrl  }
+{  0.2.8   21 Jan 99  LdB    Max data sizes added.         }
+{  0.2.9   22 Jan 99  LdB    General array types added.    }
+{  0.3.0   27 Oct 99  LdB    Delphi3+ MaxAvail, MemAvail   }
+{  0.4.0   14 Nov 00  LdB    Revamp of whole unit          }
+{**********************************************************}
+
+UNIT FVCommon;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I Platform.inc}
+{====================================================================}
+
+{***************************************************************************}
+{                              PUBLIC CONSTANTS                             }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        SYSTEM ERROR BASE CONSTANTS                        }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  The following ranges have been defined for error codes:                  }
+{---------------------------------------------------------------------------}
+{        0 -  1000    OS dependant error codes                              }
+{     1000 - 10000    API reserved error codes                              }
+{    10000 -          Add-On unit error codes                               }
+{---------------------------------------------------------------------------}
+
+{---------------------------------------------------------------------------}
+{                         DEFINED BASE ERROR CONSTANTS                      }
+{---------------------------------------------------------------------------}
+CONST
+   errOk                = 0;                          { No error }
+   errVioBase           = 1000;                       { Video base offset }
+   errKbdBase           = 1010;                       { Keyboard base offset }
+   errFileCtrlBase      = 1020;                       { File IO base offset }
+   errMouseBase         = 1030;                       { Mouse base offset }
+
+{---------------------------------------------------------------------------}
+{                            MAXIUM DATA SIZES                              }
+{---------------------------------------------------------------------------}
+CONST
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITION }
+   MaxBytes = 65520;                                  { Maximum data size }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITION }
+   MaxBytes = 128*1024*1024;                          { Maximum data size }
+{$ENDIF}
+   MaxWords = MaxBytes DIV SizeOf(Word);              { Max words }
+   MaxInts  = MaxBytes DIV SizeOf(Integer);           { Max integers }
+   MaxLongs = MaxBytes DIV SizeOf(LongInt);           { Max longints }
+   MaxPtrs  = MaxBytes DIV SizeOf(Pointer);           { Max pointers }
+   MaxReals = MaxBytes DIV SizeOf(Real);              { Max reals }
+   MaxStr   = MaxBytes DIV SizeOf(String);            { Max strings }
+
+{***************************************************************************}
+{                          PUBLIC TYPE DEFINITIONS                          }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                           CPU TYPE DEFINITIONS                            }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_32}                                       { 32 BIT CODE }
+   CPUWord = Longint;                                 { CPUWord is 32 bit }
+   CPUInt = Longint;                                  { CPUInt is 32 bit }
+{$ELSE}                                               { 16 BIT CODE }
+   CPUWord = Word;                                    { CPUWord is 16 bit }
+   CPUInt = Integer;                                  { CPUInt is 16 bit }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                     16/32 BIT SWITCHED TYPE CONSTANTS                     }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITIONS }
+   Sw_Word    = Word;                                 { Standard word }
+   Sw_Integer = Integer;                              { Standard integer }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITIONS }
+   Sw_Word    = LongInt;                              { Long integer now }
+   Sw_Integer = LongInt;                              { Long integer now }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                           FILE HANDLE SIZE                                }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF OS_DOS}                                       { DOS DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_ATARI}                                     { ATARI DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_LINUX}                                     { LINUX DEFINITIONS }
+ { values are words, though the OS calls return 32-bit values }
+ { to check (CEC)                                             }
+  THandle = LongInt;                                  { Simulated 32 bits }
+{$ENDIF}
+{$IFDEF OS_AMIGA}                                     { AMIGA DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+{$IFDEF OS_WINDOWS}                                   { WIN/NT DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_OS2}                                       { OS2 DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_MAC}                                       { MACINTOSH DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                      POINTERS TO STANDARD DATA TYPES                      }
+{---------------------------------------------------------------------------}
+TYPE
+   PByte = ^Byte;                                     { Pointer to byte }
+   PWord = ^Word;                                     { Pointer to word }
+   PLongint = ^Longint;                               { Pointer to longint }
+
+{---------------------------------------------------------------------------}
+{                               GENERAL ARRAYS                              }
+{---------------------------------------------------------------------------}
+TYPE
+   TByteArray = ARRAY [0..MaxBytes-1] Of Byte;        { Byte array }
+   PByteArray = ^TByteArray;                          { Byte array pointer }
+
+   TWordArray = ARRAY [0..MaxWords-1] Of Word;        { Word array }
+   PWordArray = ^TWordArray;                          { Word array pointer }
+
+   TIntegerArray = ARRAY [0..MaxInts-1] Of Integer;   { Integer array }
+   PIntegerArray = ^TIntegerArray;                    { Integer array pointer }
+
+   TLongIntArray = ARRAY [0..MaxLongs-1] Of LongInt;  { LongInt array }
+   PLongIntArray = ^TLongIntArray;                    { LongInt array pointer }
+
+   TRealArray = Array [0..MaxReals-1] Of Real;        { Real array }
+   PRealarray = ^TRealArray;                          { Real array pointer }
+
+   TPointerArray = Array [0..MaxPtrs-1] Of Pointer;   { Pointer array }
+   PPointerArray = ^TPointerArray;                    { Pointer array ptr }
+
+   TStrArray = Array [0..MaxStr-1] Of String;         { String array }
+   PStrArray = ^TStrArray;                            { String array ptr }
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{-GetErrorCode-------------------------------------------------------
+Returns the last error code and resets ErrorCode to errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+
+{-GetErrorInfo-------------------------------------------------------
+Returns the info assigned to the previous error, doesn't reset the
+value to nil. Would usually only be called if ErrorCode <> errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+
+{-MinimumOf----------------------------------------------------------
+Given two real numbers returns the minimum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+
+{-MaximumOf----------------------------------------------------------
+Given two real numbers returns the maximum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+
+{-MinIntegerOf-------------------------------------------------------
+Given two integer values returns the lowest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+
+{-MaxIntegerof-------------------------------------------------------
+Given two integer values returns the biggest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+
+{-MinLongIntOf-------------------------------------------------------
+Given two long integers returns the minimum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+
+{-MaxLongIntOf-------------------------------------------------------
+Given two long integers returns the maximum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{ ******************************* REMARK ****************************** }
+{  Delphi 3+ does not define these standard routines so I have made     }
+{  some public functions here to complete compatability.                }
+{ ****************************** END REMARK *** Leon de Boer, 14Aug98 * }
+
+{-MemAvail-----------------------------------------------------------
+Returns the free memory available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+
+{-MaxAvail-----------------------------------------------------------
+Returns the max free memory block size available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+{$ENDIF}
+
+{***************************************************************************}
+{                        INITIALIZED PUBLIC VARIABLES                       }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
+{---------------------------------------------------------------------------}
+CONST
+   ErrorCode: Longint = errOk;                        { Last error code }
+   ErrorInfo: Pointer = Nil;                          { Last error info }
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                               IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ COMPILER }
+USES WinTypes, WinProcs;                              { Stardard units }
+{$ENDIF}
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  GetErrorCode -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+BEGIN
+   GetErrorCode := ErrorCode;                         { Return last error }
+   ErrorCode := 0;                                    { Now clear errorcode }
+END;
+
+{---------------------------------------------------------------------------}
+{  GetErrorInfo -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+BEGIN
+   GetErrorInfo := ErrorInfo;                         { Return errorinfo ptr }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I < J) Then Min := I Else Min := J;          { Select minimum }
+END;
+
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I > J) Then Max := I Else Max := J;          { Select maximum }
+END;
+
+
+{---------------------------------------------------------------------------}
+{  MinimumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+BEGIN
+   If (B < A) Then MinimumOf := B                     { B smaller take it }
+     Else MinimumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaximumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+BEGIN
+   If (B > A) Then MaximumOf := B                     { B bigger take it }
+     Else MaximumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B < A) Then MinIntegerOf := B                  { B smaller take it }
+     Else MinIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B > A) Then MaxIntegerOf := B                  { B bigger take it }
+     Else MaxIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B < A) Then MinLongIntOf := B                  { B smaller take it }
+     Else MinLongIntOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B > A) Then MaxLongIntOf := B                  { B bigger take it }
+     Else MaxLongIntOf := A;                          { Else take A }
+END;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MemAvail := Ms.dwAvailPhys;                        { Avail physical memory }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MaxAvail := Ms.dwTotalPhys;                        { Max physical memory }
+END;
+{$ENDIF}
+
+END.
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:20  marco
+  * CVS log and ID tags
+
+
+}

+ 631 - 0
fv/fvconsts.pas

@@ -0,0 +1,631 @@
+{ $Id$  }
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of DIALOGS.PAS      }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
+{   [email protected]  - primary e-mail addr           }
+{   [email protected] - backup e-mail addr            }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{                                                          }
+{ Only Free Pascal Compiler supported                      }
+{                                                          }
+{**********************************************************}
+unit FVConsts;
+interface
+
+{
+  The ObjTypes unit declares constants for all object type IDs used in the
+  FreeVision library.  They have been moved here for easier management.  No
+  values for views declared in TV 2.0 have been changed from so that original
+  resource files may still be used.
+}
+const
+  { Views Unit }
+  idView = 1;
+  idFrame = 2;
+  idScrollBar = 3;
+  idScroller = 4;
+  idListViewer = 5;
+  idGroup = 6;
+  idWindow = 7;
+
+  { Dialogs Unit 10 - ? }
+  idDialog = 10;
+  idInputLine = 11;
+  idButton = 12;
+  idCluster = 13;
+  idRadioButtons = 14;
+  idCheckBoxes = 15;
+  idMultiCheckBoxes = 27;
+  idListBox = 16;
+  idStaticText = 17;
+  idLabel = 18;
+  idHistory = 19;
+  idParamText = 20;
+  idCommandCheckBoxes = 21;
+  idCommandRadioButtons = 22;
+  idCommandIcon = 23;
+  idBrowseButton = 24;
+  idEditListBox = 25;
+  idModalInputLine = 26;
+  idListDlg = 27;
+
+  { App Unit }
+  idBackground = 30;
+  idDesktop = 31;
+
+  { Config Unit }
+  idConfig = 32;
+  idMouseDlg = 33;
+  idVideoDlg = 34;
+  idClickTester = 35;
+
+  { Menus Unit }
+  idMenuBar = 40;
+  idMenuBox = 41;
+  idStatusLine = 42;
+  idMenuPopup = 43;
+  idMenuButton = 44;
+
+  { Objects Unit }
+  idCollection = 50;
+  idStringCollection = 51;
+  idStringList = 52;
+  idStrListMaker = 52;
+  idStrCollection = 69;
+
+  { Resource Unit }
+  idMemStringList = 52;
+
+  { StdDlg Unit }
+  idFileInputLine = 60;
+  idFileCollection = 61;
+  idFileList = 62;
+  idFileInfoPane = 63;
+  idFileDialog = 64;
+  idDirCollection = 65;
+  idDirListBox = 66;
+  idChDirDialog = 67;
+  idSortedListBox = 68;
+  idEditChDirDialog = 69;
+
+  { Editors Unit   70 - ? }
+  idEditor = 70;
+  idMemo = 71;
+  idFileEditor = 72;
+  idIndicator = 73;
+  idEditWindow = 74;
+  idEditWindowCollection = 75; { this value may need to be changed }
+  idEditorEngine = 76;
+
+  { Validate Unit }
+  idPXPictureValidator = 80;
+  idFilterValidator = 81;
+  idRangeValidator = 82;
+  idStringLookupValidator = 83;
+  idRealValidator = 84;
+  idByteValidator = 85;
+  idIntegerValidator = 86;
+  idSingleValidator = 87;
+  idWordValidator = 88;
+  idDateValidator = 89;
+  idTimeValidator = 90;
+
+  { Outline Unit }
+  idOutline = 91;
+
+  { ColorSel Unit }
+  idColorSelector = 92;
+  idMonoSelector = 93;
+  idColorDisplay = 94;
+  idColorGroupList = 95;
+  idColorItemList = 96;
+  idColorDialog = 97;
+
+  { Statuses Unit }
+  idStatus   = 300;
+  idStatusDlg = 301;
+  idStatusMessageDlg = 302;
+  idGauge = 303;
+  idArrowGauge = 304;
+  idBarGauge = 305;
+  idPercentGauge = 306;
+  idSpinnerGauge = 307;
+  idAppStatus = 308;
+  idHeapMinAvail = 309;
+  idHeapMemAvail = 310;
+
+  { FVList Unit }
+
+
+{
+ The Commands unit contains all command constants used in the FreeVision
+ library.  They have been extracted from their original units and placed here
+ for easier maintainence and modification to remove conflicts, such as Borland
+ created with the cmChangeDir constant in the StdDlg and App units.
+}
+
+const
+  { App Unit }
+  cmNew           = 30;
+  cmOpen          = 31;
+  cmSave          = 32;
+  cmSaveAs        = 33;
+  cmSaveAll       = 34;
+  cmSaveDone      = 35;
+  cmChangeDir     = 36;
+  cmDosShell      = 37;
+  cmCloseAll      = 38;
+  cmDelete        = 39;
+  cmEdit          = 40;
+  cmAbout         = 41;
+  cmDesktopLoad   = 42;
+  cmDesktopStore  = 43;
+  cmNewDesktop    = 44;
+  cmNewMenuBar    = 45;
+  cmNewStatusLine = 46;
+  cmNewVideo      = 47;
+  cmTransfer      = 48;
+
+  cmRecordHistory  = 60;
+  cmGrabDefault    = 61;
+  cmReleaseDefault = 62;
+
+  cmHelpContents  = 256;
+  cmHelpIndex     = 257;
+  cmHelpTopic     = 258;
+  cmHelpPrev      = 259;
+  cmHelpUsingHelp = 260;
+  cmHelpAbout     = 261;
+
+  cmBrowseDir     = 262;
+  cmBrowseFile    = 263;
+
+  { Views Unit }
+  cmValid   = 0;
+  cmQuit    = 1;
+  cmError   = 2;
+  cmMenu    = 3;
+  cmClose   = 4;
+  cmZoom    = 5;
+  cmResize  = 6;
+  cmNext    = 7;
+  cmPrev    = 8;
+  cmHelp    = 9;
+  cmOK      = 10;
+  cmCancel  = 11;
+  cmYes     = 12;
+  cmNo      = 13;
+  cmDefault = 14;
+  cmCut     = 20;
+  cmCopy    = 21;
+  cmPaste   = 22;
+  cmUndo    = 23;
+  cmClear   = 24;
+  cmTile    = 25;
+  cmCascade = 26;
+  cmHide    = 27;
+  cmReceivedFocus     = 50;
+  cmReleasedFocus     = 51;
+  cmCommandSetChanged = 52;
+  cmScrollBarChanged  = 53;
+  cmScrollBarClicked  = 54;
+  cmSelectWindowNum   = 55;
+  cmListItemSelected  = 56;
+
+  { ColorSel Unit }
+  cmColorForegroundChanged = 71;
+  cmColorBackgroundChanged = 72;
+  cmColorSet               = 73;
+  cmNewColorItem           = 74;
+  cmNewColorIndex          = 75;
+  cmSaveColorIndex         = 76;
+
+  { StdDlg Unit   800 - ? }
+  cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
+  cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
+  cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
+  cmFileInit    = 803;   { Used by TFileDialog internally }
+  cmRevert      = 805;   { Used by TChDirDialog internally }
+  cmFileFocused = 806;    { A new file was focused in the TFileList }
+  cmFileDoubleClicked = 807;  { A file was selected in the TFileList }
+
+  { Config Unit   130-140, 900-999 }
+  cmConfigMouse       = 130; { Mouse command disabled by Init if no mouse }
+  cmConfigOpen        = 900;
+  cmConfigSave        = 901;
+  cmConfigSaveAs      = 902;
+  cmConfigMenu        = 903;
+  cmConfigColors      = 904;
+  cmConfigVideo       = 905;
+  cmConfigCO80        = 906;
+  cmConfigBW80        = 907;
+  cmConfigMono        = 908;
+  cmClock             = 909;
+  cmClockSetFormat    = 910;
+
+    { Editors Unit }
+  cmFind           = 82;
+  cmReplace        = 83;
+  cmSearchAgain    = 84;
+  cmPrint          = 85;
+  cmRedo           = 86;
+  cmJumpLine       = 87;
+  cmWindowList     = 88;
+  cmCharLeft       = 500;
+  cmCharRight      = 501;
+  cmWordLeft       = 502;
+  cmWordRight      = 503;
+  cmLineStart      = 504;
+  cmLineEnd        = 505;
+  cmLineUp         = 506;
+  cmLineDown       = 507;
+  cmPageUp         = 508;
+  cmPageDown       = 509;
+  cmTextStart      = 510;
+  cmTextEnd        = 511;
+  cmNewLine        = 512;
+  cmBackSpace      = 513;
+  cmDelChar        = 514;
+  cmDelWord        = 515;
+  cmDelStart       = 516;
+  cmDelEnd         = 517;
+  cmDelLine        = 518;
+  cmInsMode        = 519;
+  cmStartSelect    = 520;
+  cmHideSelect     = 521;
+  cmEndSelect      = 522;
+  cmIndentMode     = 523;
+  cmUpdateTitle    = 524;
+  cmReformPara     = 525;
+  cmTabKey         = 526;
+  cmInsertLine     = 527;
+  cmScrollUp       = 528;
+  cmScrollDown     = 529;
+  cmHomePage       = 530;
+  cmEndPage        = 531;
+  cmJumpMark0      = 532;
+  cmJumpMark1      = 533;
+  cmJumpMark2      = 534;
+  cmJumpMark3      = 535;
+  cmJumpMark4      = 536;
+  cmJumpMark5      = 537;
+  cmJumpMark6      = 538;
+  cmJumpMark7      = 539;
+  cmJumpMark8      = 540;
+  cmJumpMark9      = 541;
+  cmReformDoc      = 542;
+  cmSetMark0       = 543;
+  cmSetMark1       = 544;
+  cmSetMark2       = 545;
+  cmSetMark3       = 546;
+  cmSetMark4       = 547;
+  cmSetMark5       = 548;
+  cmSetMark6       = 549;
+  cmSetMark7       = 550;
+  cmSetMark8       = 551;
+  cmSetMark9       = 552;
+  cmSelectWord     = 553;
+  cmSaveExit       = 554;
+  cmCenterText     = 555;
+  cmSetTabs        = 556;
+  cmRightMargin    = 557;
+  cmWordwrap       = 558;
+  cmBludgeonStats  = 559;
+  cmPrinterSetup   = 560;
+  cmClipboard      = 561;
+  cmSpellCheck     = 562;
+  cmCopyBlock      = 563;
+  cmMoveBlock      = 564;
+  cmDelSelect      = 565;
+  cmIdentBlock     = 566;
+  cmUnidentBlock   = 567;
+  cmFileHistory    = 600;
+
+  { Statuses Unit }
+  cmStatusUpdate = 300;  { note - need to set to valid value }
+  cmStatusDone   = 301;
+  cmStatusPause  = 302;
+  cmStatusResume = 303;
+
+  cmCursorChanged = 700;
+
+
+{
+  The HelpCtx unit declares standard help contexts used in FreeVision.  By
+  placing all help contexts in one unit, duplicate help contexts are more
+  easily prevented
+}
+
+const
+
+  hcNoContext = 0;
+  hcDragging = 1;
+  hcOk = 2;
+  hcCancel = 3;
+  hcEdit   = 4;
+  hcDelete = 5;
+  hcInsert = 6;
+
+    { App Unit }
+  hcNew = 65281;        hcFileNew = hcNew;
+  hcOpen = 65282;       hcFileOpen = hcOpen;
+  hcSave = 65283;       hcFileSave = hcSave;
+  hcSaveAs = 65284;     hcFileSaveAs = hcSaveAs;
+  hcSaveAll = 65285;    hcFileSaveAll = hcSaveAll;
+  hcChangeDir = 65286;  hcFileChangeDir = hcChangeDir;
+  hcDosShell = 65287;   hcFileDOSShell = hcDosShell;
+  hcExit = 65288;       hcFileExit = hcExit;
+  hcEditMenu = 65289;
+  hcHelpMenu = 65291;
+  hcHelpContents = 65292;
+  hcHelpIndex = 65293;
+  hcHelpTopic = 65294;
+  hcHelpPrev = 65295;
+  hcHelpUsingHelp = 65296;
+  hcHelpAbout = 65297;
+  hcWindowMenu = 65298;
+  hcUndo         = $FF10;
+  hcCut          = $FF11;
+  hcCopy         = $FF12;
+  hcPaste        = $FF13;
+  hcClear        = $FF14;
+  hcTile         = $FF20;
+  hcCascade      = $FF21;
+  hcCloseAll     = $FF22;
+  hcResize       = $FF23;
+  hcZoom         = $FF24;
+  hcNext         = $FF25;
+  hcPrev         = $FF26;
+  hcClose        = $FF27;
+  hcHide         = $FF28;
+  hcFileMenu     = 65320;
+  hcSearchAndReplace =65325;
+
+    { Editors Unit }
+  hcFile_Menu            = 2100;
+{ hcOpen                 = 2101; }
+{ hcNew                  = 2102; }
+{ hcSave                 = 2103; }
+  hcSaveDone             = 2104;
+{ hcSaveAs               = 2105; }
+{ hcChangeDir            = 2106; }
+{ hcShellToDos           = 2107; }
+{ hcExit                 = 2108; }
+  hcFile_Menu_Items      = hcExit;
+
+  hcEdit_Menu            = 2200;
+{ hcUndo                 = 2201; }
+{ hcCopy                 = 2202; }
+{ hcCut                  = 2203; }
+{ hcPaste                = 2204; }
+  hcClipboard            = 2205;
+{ hcClear                = 2206; }
+  hcSpellCheck           = 2207;
+  hcEdit_Menu_Items      = hcSpellCheck;
+
+  hcSearch_Menu          = 2300;
+  hcFind                 = 2301;
+  hcReplace              = 2302;
+  hcAgain                = 2303;
+  hcSearch_Menu_Items    = hcAgain;
+
+  hcWindows_Menu         = 2400;
+{  hcResize               = 2401; }
+{  hcZoom                 = 2402; }
+{  hcPrev                 = 2403; }
+{  hcNext                 = 2404; }
+{  hcClose                = 2405; }
+{  hcTile                 = 2406; }
+{  hcCascade              = 2407; }
+  hcWindows_Menu_Items   = hcCascade;
+
+  hcDesktop_Menu         = 2500;
+  hcLoadDesktop          = 2501;
+  hcSaveDesktop          = 2502;
+  hcToggleVideo          = 2503;
+  hcDesktop_Menu_Items   = hcToggleVideo;
+
+  hcMisc_Commands        = 2600;
+  hckbShift              = 2601;
+  hckbCtrl               = 2602;
+  hckbAlt                = 2603;
+  hcMisc_Items           = hckbAlt;
+
+  hcEditor_Commands      = 2700;
+  hcCursor               = 2701;
+  hcDeleting             = 2702;
+  hcFormatting           = 2703;
+  hcMarking              = 2704;
+  hcMoving               = 2705;
+  hcSaving               = 2706;
+  hcSelecting            = 2707;
+  hcTabbing              = 2708;
+  hcBackSpace            = 2709;
+  hcCenterText           = 2710;
+  hcCharLeft             = 2711;
+  hcCharRight            = 2712;
+  hcDelChar              = 2713;
+  hcDelEnd               = 2714;
+  hcDelLine              = 2715;
+  hcDelStart             = 2716;
+  hcDelWord              = 2717;
+  hcEndPage              = 2718;
+  hcHideSelect           = 2719;
+  hcHomePage             = 2720;
+  hcIndentMode           = 2721;
+  hcInsertLine           = 2722;
+  hcInsMode              = 2723;
+  hcJumpLine             = 2724;
+  hcLineDown             = 2725;
+  hcLineEnd              = 2726;
+  hcLineStart            = 2727;
+  hcLineUp               = 2728;
+  hcNewLine              = 2729;
+  hcPageDown             = 2730;
+  hcPageUp               = 2731;
+  hcReformDoc            = 2732;
+  hcReformPara           = 2733;
+  hcRightMargin          = 2734;
+  hcScrollDown           = 2735;
+  hcScrollUp             = 2736;
+  hcSearchAgain          = 2737;
+  hcSelectWord           = 2738;
+  hcSetTabs              = 2739;
+  hcStartSelect          = 2740;
+  hcTabKey               = 2741;
+  hcTextEnd              = 2742;
+  hcTextStart            = 2743;
+  hcWordLeft             = 2744;
+  hcWordRight            = 2745;
+  hcWordWrap             = 2746;
+
+  hcJMarker_Menu         = 2750;
+  hcJumpMark1            = 2751;
+  hcJumpMark2            = 2752;
+  hcJumpMark3            = 2753;
+  hcJumpMark4            = 2754;
+  hcJumpMark5            = 2755;
+  hcJumpMark6            = 2756;
+  hcJumpMark7            = 2757;
+  hcJumpMark8            = 2758;
+  hcJumpMark9            = 2759;
+  hcJumpMark0            = 2760;
+  hcJMarker_Menu_Items   = 2761;
+
+  hcSMarker_Menu         = 2770;
+  hcSetMark1             = 2771;
+  hcSetMark2             = 2772;
+  hcSetMark3             = 2773;
+  hcSetMark4             = 2774;
+  hcSetMark5             = 2775;
+  hcSetMark6             = 2776;
+  hcSetMark7             = 2777;
+  hcSetMark8             = 2778;
+  hcSetMark9             = 2779;
+  hcSetMark0             = 2780;
+  hcSMarker_Menu_Items   = 2781;
+
+  hcEditor_Items         = hcSMarker_Menu_Items;
+
+  { Dialog }
+  hcDialogs              = 2800;
+  hcDCancel              = 2801;
+  hcDNo                  = 2802;
+  hcDOk                  = 2803;
+  hcDYes                 = 2804;
+  hcDAbout               = 2805;
+  hcDDirName             = 2806;
+  hcDDirTree             = 2807;
+  hcDChDir               = 2808;
+  hcDRevert              = 2809;
+  hcDName                = 2810;
+  hcDFiles               = 2811;
+  hcDFindText            = 2812;
+  hcDLineNumber          = 2813;
+  hcDReformDoc           = 2814;
+  hcDReplaceTExt         = 2815;
+  hcDRightMargin         = 2816;
+  hcDTabStops            = 2817;
+  hcListDlg              = 2818;
+
+  { Checkbox help }
+  hcCCaseSensitive       = 2900;
+  hcCWholeWords          = 2901;
+  hcCPromptReplace       = 2902;
+  hcCReplaceAll          = 2903;
+  hcCReformCurrent       = 2904;
+  hcCReformEntire        = 2905;
+
+    { Statuses unit }
+  hcStatusPause          = 2950;
+  hcStatusResume         = 2951;
+
+  { Glossary }
+  Glossary               = 3000;
+  GCloseIcon             = 3001;
+  GDesktop               = 3002;
+  GDialogBox             = 3003;
+  GHistoryIcon           = 3004;
+  GInputLine             = 3005;
+  GMemIndicator          = 3006;
+  GMenuBar               = 3007;
+  GPulldownMenu          = 3008;
+  GResizeCorner          = 3009;
+  GSelectedText          = 3010;
+  GStatusBar             = 3011;
+  GTitleBar              = 3012;
+  GWindowBorder          = 3013;
+  GZoomIcon              = 3014;
+  hcGlossary_Items       = GZoomIcon;
+
+    { INI Unit }
+  hcDateFormatDlg = 1;
+  hcDateParts = 1;
+  hcDateOrder = 1;
+  hcTimeFormatDlg = 1;
+  hcClockFormatDlg = 1;
+  hcClockDateParts = 1;
+  hcClockTimeFormat = 1;
+
+  hcListViewer = 1;
+
+  { Options Help Contexts }
+  hcConfigMenu          = 100;
+  hcConfigColors        = hcConfigMenu + 1;
+  hcConfigDate          = hcConfigColors + 1;
+  hcConfigEnvironment   = hcConfigDate + 1;
+  hcConfigMouse         = hcConfigEnvironment + 1;
+  hcConfigOpen          = hcConfigMouse + 1;
+  hcConfigSave          = hcConfigOpen + 1;
+  hcConfigSaveAs        = hcConfigSave + 1;
+  hcConfigTime          = hcConfigSaveAs + 1;
+  hcConfigVideo         = hcConfigTime + 1;
+  hcConfigDesktopDlg    = hcConfigVideo + 1;
+  hcConfigMouseDlg      = hcConfigDesktopDlg + 1;
+  hcConfigTimeFormatDlg = hcConfigMouseDlg + 1;
+  hcConfigTimeSeparator = hcConfigTimeFormatDlg + 1;
+  hcConfigTimeComponents = hcConfigTimeSeparator + 1;
+  hcConfigTimeStyle = hcConfigTimeComponents + 1;
+  hcConfigClock = hcConfigTimeStyle + 1;
+  hcBrowseDir = 1;
+  hcBrowseFile = 1;
+
+
+{
+  The History unit contains all history list constants used in the FreeVision
+  Library.
+}
+
+const
+  hiConfig = 1;
+  hiDirectories = 2;  { non-specific }
+  hiDesktop = 3;
+  hiCurrentDirectories = 1;
+  hiFiles = 4;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:33  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

+ 7 - 3
fv/gadgets.pas

@@ -95,7 +95,7 @@ UNIT Gadgets;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Time, Objects, Drivers, Views, App;      { Standard GFV units }
+USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                        PUBLIC OBJECT DEFINITIONS                          }
 {                        PUBLIC OBJECT DEFINITIONS                          }
@@ -226,8 +226,12 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:21  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:21  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 30 - 7
fv/histlist.pas

@@ -76,7 +76,7 @@ UNIT HistList;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Objects;                                 { Standard GFV units }
+USES FVCommon, Objects;                                 { Standard GFV units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -112,7 +112,7 @@ FUNCTION HistoryCount (Id: Byte): Word;
 Returns the Index'th string in the history list with ID number Id.
 Returns the Index'th string in the history list with ID number Id.
 30Sep99 LdB
 30Sep99 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION HistoryStr (Id: Byte; Index: Integer): String;
+FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
 
 
 {-ClearHistory-------------------------------------------------------
 {-ClearHistory-------------------------------------------------------
 Removes all strings from all history lists.
 Removes all strings from all history lists.
@@ -126,6 +126,8 @@ Adds the string Str to the history list indicated by Id.
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -204,7 +206,7 @@ END;
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE DeleteString;
 PROCEDURE DeleteString;
-VAR Len: Integer; P, P2: PChar;
+VAR Len: Sw_Integer; P, P2: PChar;
 BEGIN
 BEGIN
    P := PChar(CurString);                             { Current string }
    P := PChar(CurString);                             { Current string }
    P2 := PChar(CurString);                            { Current string }
    P2 := PChar(CurString);                            { Current string }
@@ -307,8 +309,8 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION HistoryStr(Id: Byte; Index: Integer): String;
-VAR I: Integer;
+FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    StartId(Id);                                       { Set to first record }
    StartId(Id);                                       { Set to first record }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
@@ -346,6 +348,23 @@ BEGIN
    InsertString(Id, Str);                             { Add new history item }
    InsertString(Id, Str);                             { Add new history item }
 END;
 END;
 
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+var
+  I: Sw_Integer;
+begin
+  StartId(Id);
+  for I := 0 to Index do
+   AdvanceStringPtr;                                  { Find the string }
+  if CurString <> nil then
+    begin
+       DeleteString;
+       HistoryRemove:=true;
+    end
+  else
+    HistoryRemove:=false;
+end;
+
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -381,8 +400,12 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 304 - 0
fv/inplong.pas

@@ -0,0 +1,304 @@
+Unit InpLong;
+
+(*--
+TInputLong is a derivitave of TInputline designed to accept LongInt
+numeric input.  Since both the upper and lower limit of acceptable numeric
+input can be set, TInputLong may be used for Integer, Word, or Byte input
+as well.  Option flag bits allow optional hex input and display.  A blank
+field may optionally be rejected or interpreted as zero.
+
+Methods
+
+constructor Init(var R : TRect; AMaxLen : Integer;
+                LowerLim, UpperLim : LongInt; Flgs : Word);
+
+Calls TInputline.Init and saves the desired limits and Flags.  Flags may
+be a combination of:
+
+ilHex          will accept hex input (preceded by '$')  as well as decimal.
+ilBlankEqZero  if set, will interpret a blank field as '0'.
+ilDisplayHex   if set, will display numeric as hex when possible.
+
+
+constructor Load(var S : TStream);
+procedure Store(var S : TStream);
+
+The usual Load and Store routines.  Be sure to call RegisterType(RInputLong)
+to register the type.
+
+
+FUNCTION DataSize : Word; virtual;
+PROCEDURE GetData(var Rec); virtual;
+PROCEDURE SetData(var Rec); virtual;
+
+The transfer methods.  DataSize is Sizeof(LongInt) and Rec should be
+the address of a LongInt.
+
+
+FUNCTION RangeCheck : Boolean; virtual;
+
+Returns True if the entered string evaluates to a number >= LowerLim and
+<= UpperLim.
+
+
+PROCEDURE Error; virtual;
+
+Error is called when RangeCheck fails.  It displays a messagebox indicating
+the label (if any) of the faulting view, as well as the allowable range.
+
+
+PROCEDURE HandleEvent(var Event : TEvent); virtual;
+
+HandleEvent filters out characters which are not appropriate to numeric
+input.  Tab and Shift Tab cause a call to RangeCheck and a call to Error
+if RangeCheck returns false.  The input must be valid to Tab from the view.
+There's no attempt made to stop moving to another view with the mouse.
+
+
+FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+
+if TInputline.Valid is true and Cmd is neither cmValid or cmCancel, Valid
+then calls RangeCheck.  If RangeCheck is false, then Error is called and
+Valid returns False.
+
+----*)
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+Interface
+uses Objects, Drivers, Views, Dialogs, MsgBox;
+
+{flags for TInputLong constructor}
+const
+  ilHex = 1;          {will enable hex input with leading '$'}
+  ilBlankEqZero = 2;  {No input (blank) will be interpreted as '0'}
+  ilDisplayHex = 4;   {Number displayed as hex when possible}
+Type
+  TInputLong = Object(TInputLine)
+    ILOptions : Word;
+    LLim, ULim : LongInt;
+    constructor Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+    constructor Load(var S : TStream);
+    procedure Store(var S : TStream);
+    FUNCTION DataSize : Sw_Word; virtual;
+    PROCEDURE GetData(var Rec); virtual;
+    PROCEDURE SetData(var Rec); virtual;
+    FUNCTION RangeCheck : Boolean; virtual;
+    PROCEDURE Error; virtual;
+    PROCEDURE HandleEvent(var Event : TEvent); virtual;
+    FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+    end;
+  PInputLong = ^TInputLong;
+
+const
+  RInputLong : TStreamRec = (
+    ObjType: 711;
+    VmtLink: Ofs(Typeof(TInputLong)^);
+    Load : @TInputLong.Load;
+    Store : @TInputLong.Store);
+
+Implementation
+
+uses
+  FVConsts;
+
+{-----------------TInputLong.Init}
+constructor TInputLong.Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+begin
+if not TInputLine.Init(R, AMaxLen) then fail;
+ULim := UpperLim;
+LLim := LowerLim;
+if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
+ILOptions := Flgs;
+if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
+end;
+
+{-------------------TInputLong.Load}
+constructor TInputLong.Load(var S : TStream);
+begin
+TInputLine.Load(S);
+S.Read(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.Store}
+procedure TInputLong.Store(var S : TStream);
+begin
+TInputLine.Store(S);
+S.Write(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.DataSize}
+FUNCTION TInputLong.DataSize:Sw_Word;
+begin
+DataSize := Sizeof(LongInt);
+end;
+
+{-------------------TInputLong.GetData}
+PROCEDURE TInputLong.GetData(var Rec);
+var code : Integer;
+begin
+Val(Data^, LongInt(Rec), code);
+end;
+
+FUNCTION Hex2(B : Byte) : String;
+Const
+  HexArray : array[0..15] of char = '0123456789ABCDEF';
+begin
+Hex2[0] := #2;
+Hex2[1] := HexArray[B shr 4];
+Hex2[2] := HexArray[B and $F];
+end;
+
+FUNCTION Hex4(W : Word) : String;
+begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
+
+FUNCTION Hex8(L : LongInt) : String;
+begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
+
+function FormHexStr(L : LongInt) : String;
+var
+  Minus : boolean;
+  S : string[20];
+begin
+Minus := L < 0;
+if Minus then L := -L;
+S := Hex8(L);
+while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
+S := '$' + S;
+if Minus then System.Insert('-', S, 2);
+FormHexStr := S;
+end;
+
+{-------------------TInputLong.SetData}
+PROCEDURE TInputLong.SetData(var Rec);
+var
+  L : LongInt;
+  S : string;
+begin
+L := LongInt(Rec);
+if L > ULim then L := ULim
+else if L < LLim then L := LLim;
+if ILOptions and ilDisplayHex <> 0 then
+  S := FormHexStr(L)
+else
+  Str(L : -1, S);
+if Length(S) > MaxLen then S[0] := chr(MaxLen);
+Data^ := S;
+end;
+
+{-------------------TInputLong.RangeCheck}
+FUNCTION TInputLong.RangeCheck : Boolean;
+var
+  L : LongInt;
+  code : Integer;
+begin
+if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
+  Data^ := '0';
+Val(Data^, L, code);
+RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
+end;
+
+{-------------------TInputLong.Error}
+PROCEDURE TInputLong.Error;
+var
+  SU, SL : string[40];
+  PMyLabel : PLabel;
+  Labl : string;
+  I : Integer;
+
+  function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
+  begin
+  FindIt := (Typeof(P^) = Typeof(TLabel)) and (PLabel(P)^.Link = PView(@Self));
+  end;
+
+begin
+Str(LLim : -1, SL);
+Str(ULim : -1, SU);
+if ILOptions and ilHex <> 0 then
+  begin
+  SL := SL+'('+FormHexStr(LLim)+')';
+  SU := SU+'('+FormHexStr(ULim)+')';
+  end;
+if Owner <> Nil then
+  PMyLabel := PLabel(Owner^.FirstThat(@FindIt))
+else PMyLabel := Nil;
+if PMyLabel <> Nil then PMyLabel^.GetText(Labl)
+else Labl := '';
+if Labl <> '' then
+  begin
+  I := Pos('~', Labl);
+  while I > 0 do
+    begin
+    System.Delete(Labl, I, 1);
+    I := Pos('~', Labl);
+    end;
+  Labl := '"'+Labl+'"';
+  end;
+MessageBox(Labl + ^M^J'Value not within range '+SL+' to '+SU, Nil,
+                            mfError+mfOKButton);
+end;
+
+{-------------------TInputLong.HandleEvent}
+PROCEDURE TInputLong.HandleEvent(var Event : TEvent);
+begin
+if (Event.What = evKeyDown) then
+  begin
+    case Event.KeyCode of
+       kbTab, kbShiftTab
+          : if not RangeCheck then
+              begin
+              Error;
+              SelectAll(True);
+              ClearEvent(Event);
+              end;
+      end;
+  if Event.CharCode <> #0 then  {a character key}
+    begin
+    Event.Charcode := Upcase(Event.Charcode);
+    case Event.Charcode of
+      '0'..'9', #1..#$1B : ;       {acceptable}
+
+      '-'       : if (LLim >= 0) or (CurPos <> 0) then
+                        ClearEvent(Event);
+      '$'       : if ILOptions and ilHex = 0 then ClearEvent(Event);
+      'A'..'F'  : if Pos('$', Data^) = 0 then ClearEvent(Event);
+
+      else ClearEvent(Event);
+      end;
+    end;
+  end;
+TInputLine.HandleEvent(Event);
+end;
+
+{-------------------TInputLong.Valid}
+FUNCTION TInputLong.Valid(Cmd : Word) : Boolean;
+var
+  Rslt : boolean;
+begin
+Rslt := TInputLine.Valid(Cmd);
+if Rslt and (Cmd <> 0) and (Cmd <> cmCancel) then
+  begin
+  Rslt := RangeCheck;
+  if not Rslt then
+    begin
+    Error;
+    Select;
+    SelectAll(True);
+    end;
+  end;
+Valid := Rslt;
+end;
+
+end.

+ 7 - 3
fv/memory.pas

@@ -75,7 +75,7 @@ UNIT Memory;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common;
+USES FVCommon;
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -828,8 +828,12 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 738 - 0
fv/resource.pas

@@ -0,0 +1,738 @@
+{ Resource Unit
+
+  Programmer: Brad Williams
+  BitSoft Development, L.L.C.
+  Copyright (c) 1996
+  Version 1.1
+
+Revision History
+
+1.1   (12/26/97)
+  - updated to add cdResource directive so that can use standard TStringList
+    resources created by TVRW and TVDT
+
+1.0
+  - original implementation }
+
+unit Resource;
+
+interface
+
+{
+  The Resource unit provides global variables which are used to build and
+  access resource files.  InitRez must always be called before accessing any
+  variables in the Resource unit.  The programmer should also always call
+  Done to free all file handles allocated to the program.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  FVConsts, Objects, Dos;
+
+const
+
+  RezExt: ExtStr = '.RES';
+    { The file extension used on all resource files. }
+  RezBufferSize: Word = 4096;
+    { RezBufferSize is the number of bytes to use for the resource file's
+      stream's buffer.  RezBufferSize is passed to TBufStream.Init. }
+
+    { reXXXX constants are used with resource files to retrieve the standard
+      Free Vision dialogs.  The constant is followed by the Unit in which it
+      is used and the resource which is stored separated by a period. }
+
+  reChDirDialog = 'ChDirDialog';  { StdDlg.TChDirDialog }
+  reEditChDirDialog = 'EditChDirDialog';  { StdDlg.TEditChDirDialog }
+  reFindTextDlg = 'FindTextDlg';  { Editors.CreateFindDialog }
+  reHints = 'Hints'; { Resource.Hints }
+  reJumpLineDlg = 'JumpLineDlg';  { Editors.MakeJumpLineDlg }
+  reLabels = 'Labels';  { Resource.Labels }
+  reMenuBar = 'MenuBar';  { App.MenuBar }
+  reOpenDlg = 'OpenDlg';  { StdDlg.TFileDialog - Open }
+  reReformDocDlg = 'ReformDocDlg';  { Editors.MakeReformDocDlg }
+  reReplaceDlg = 'ReplaceDlg';  { Editors.CreateReplaceDialog }
+  reRightMarginDlg = 'RightMarginDlg';  { Editors.MakeRightMarginDlg }
+  reStatusLine = 'StatusLine';  { App.StatusLine }
+  reStrings = 'Strings';  { Resource.Strings }
+  reSaveAsDlg = 'SaveAsDlg';  { StdDlg.TFileDialog - Save As }
+  reTabStopDlg = 'TabStopDlg';  { Editors.MakeTabStopDlg }
+  reWindowListDlg = 'WindowListDlg';  { Editors.MakeWindowListDlg }
+  reAboutDlg = 'About';  { App unit about dialog }
+
+  {$I str.inc}
+    { STR.INC declares all the string list constants used in the standard
+      Free Vision library units.  They are placed in a separate file as a
+      template for use by the resource file generator, MakeRez.
+
+      Applications which use resource files and need to add strings of their
+      own should use STR.INC as the start for the resource file.
+
+      See MakeRez.PAS for more information about generating resource files.}
+
+type
+
+
+  PConstant = ^TConstant;
+  TConstant = object(TObject)
+    Value: Word;
+      { The value assigned to the constant. }
+    constructor Init (AValue: Word; AText: string);
+      { Init assigns AValue to Value to AText to Text.  AText may be an empty
+        string.
+
+        If an error occurs Init fails. }
+    destructor Done; virtual;
+      { Done disposes of Text then calls the inherited destructor. }
+    procedure SetText (AText: string);
+      { SetText changes FText to the word equivalent of AText. }
+    procedure SetValue (AValue: string);
+      { SetValue changes Value to the word equivalent of AValue. }
+    function Text: string;
+      { Text returns a string equivalent to FText.  If FText is nil, an
+        empty string is returned. }
+    function ValueAsString: string;
+      { ValueAsString returns the string equivalent of Value. }
+      private
+    FText: PString;
+      { The text to display for the constant. }
+  end;  { of TConstant }
+
+
+  PMemStringList = ^TMemStringList;
+  TMemStringList = object(TSortedCollection)
+    { A TMemStringList combines the functions of a TStrListMaker and a
+      TStringList into one object, allowing generation and use of string
+      lists in the same application.  TMemStringList is fully compatible
+      with string lists created using TStrListMaker, so legacy applications
+      will work without problems.
+
+      When using a string list in the same program as it is created, a
+      resource file is not required.  This allows language independant coding
+      of units without the need for conditional defines and recompiling. }
+    constructor Init;
+      { Creates an empty, in-memory string list that is not associated with a
+        resource file. }
+    constructor Load (var S: TStream);
+      { Load creates a TStringList from which it gets its strings upon a call
+        to Get.  The strings on the resource file may be loaded into memory
+        for editing by calling LoadList.
+
+        If initialized with Load, the stream must remain valid for the life
+        of this object. }
+    destructor Done; virtual;
+      { Done deallocates the memory allocated to the string list. }
+    function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
+      { Compare assumes Key1 and Key2 are Word values and returns:
+
+            -1  if Key1 < Key2
+             0  if Key1 = Key2
+             1  if Key1 > Key2 }
+    function Get (Key: Word): String; virtual;
+      { GetKey searches for a string with a key matching Key and returns it.
+        An empty string is returned if a string with a matching Key is not
+        found.
+
+        If Count > 0, the in memory collection is searched.  If List^.Count
+        is 0, the inherited Get method is called. }
+    procedure Insert (Item: Pointer); virtual;
+      { If Item is not nil, Insert attempts to insert the item into the
+        collection.  If a collection expansion error occurs Insert disposes
+        of Item by calling FreeItem.
+
+        Item must be a pointer to a TConstant or its descendant. }
+    function KeyOf (Item: Pointer): Pointer; virtual;
+      { KeyOf returns a pointer to TConstant.Value. }
+    function LoadStrings: Sw_Integer;
+      { LoadStrings reads all strings the associated resource file into
+        memory, places them in the collection, and returns 0.
+
+        If an error occurs LoadStrings returns the stream status error code
+        or a DOS error code.  Possible DOS error codes include:
+
+               2:   no associated resource file
+               8:   out of memory }
+    function NewConstant (Value: Word; S: string): PConstant; virtual;
+      { NewConstant is called by LoadStrings. }
+    procedure Put (Key: Word; S: String); virtual;
+      { Put creates a new PConstant containing Key and Word then calls
+        Insert to place it in the collection. }
+    procedure Store (var S: TStream);
+      { Store creates a TStrListMaker, fills it with the items in List,
+        writes the TStrListMaker to the stream by calling
+        TStrListMaker.Store, then disposes of the TStrListMaker. }
+  private
+    StringList: PStringList;
+  end;  { of TMemStringList) }
+
+
+var
+
+  {$ifdef cdResource}
+  Hints: PStringList;
+  {$else}
+  Hints: PMemStringList;
+  {$endif cdResource}
+    { Hints is a string list for use within the application to provide
+      context sensitive help on the command line.  Hints is always used in
+      the application. }
+
+  {$ifdef cdResource}
+  Strings: PStringList;
+  {$else}
+  Strings: PMemStringList;
+  {$endif cdResource}
+    { Strings holds messages such as errors and general information that are
+      displayed at run-time, normally with MessageBox.  Strings is always
+      used in the application. }
+
+  {$ifdef cdResource}
+  Labels: PStringList;
+  {$else}
+  Labels: PMemStringList;
+  {$endif cdResource}
+    { Labels is a string list for use within the application when a
+      resource file is not used, or when creating a resource file.  Labels
+      contains all text used in dialog titles, labels, buttons, menus,
+      statuslines, etc., used in the application which can be burned into
+      language specific resources.  It does not contain any messages
+      displayed at run-time using MessageBox or the status line hints.
+
+      Using the Labels variable when creating views allows language
+      independant coding of views such as the MessageBox, StdDlg and Editors
+      units. }
+
+  RezFile: PResourceFile;
+    { RezFile is a global variable used when the Free Vision library
+      is compiled using the cdResource conditional define, or when creating
+      resource files.
+
+      All standard Free Vision application resources are accessed from the
+      resource file using the reXXXX constants.  Modify the STR.INC under a
+      new file name to create new language specific resource files.  See the
+      MakeRez program file for more information. }
+
+
+
+procedure DoneResource;
+  { Done destructs all objects initialized in this unit and frees all
+    allocated heap. }
+
+{$ifndef cdResource}
+function InitResource: Boolean;
+{$endif cdResource}
+  { Init initializes the Hints and Strings for use with in memory strings
+    lists.  Init should be used in applications which do not use a resource
+    file, or when creating resource files.  }
+
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+{$endif cdResource}
+  { InitRezFile initializes a new PResourceFile using the name passed in
+    AFile and the stream mode passed in Mode and returns 0.
+
+    If an error occurs InitRezFile returns the DOS error and AResFile is
+    invalid.  Possible DOS error values include:
+
+        2: file not found or other stream initialization error
+        11: invalid format - not a valid resource file }
+
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+{$endif cdResource}
+  { Load is used to open a resource file for use in the application.
+
+    For Load to return True, the resource file must be properly opened and
+    assigned to RezFile and the Hints string list must be successfully loaded
+    from the stream.  If an error occurs, Load displays an English error
+    message using PrintStr and returns False. }
+
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+  { MergeLists moves all key/string pairs from Source to destination,
+    deleting them from Source.  Duplicate strings are ignored. }
+
+
+const
+  RMemStringList: TStreamRec = (
+    ObjType: idMemStringList;
+    VmtLink: Ofs(TypeOf(TMemStringList)^);
+    Load: @TMemStringList.Load;
+    Store: @TMemStringList.Store);
+
+
+implementation
+
+{****************************************************************************}
+{                           Private Declarations                             }
+{****************************************************************************}
+
+uses
+  Memory, Drivers;
+
+{****************************************************************************}
+{ TConstant object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TConstant.Init                                                             }
+{****************************************************************************}
+constructor TConstant.Init (AValue: Word; AText: string);
+begin
+  if not inherited Init then
+    Fail;
+  Value := AValue;
+  FText := NewStr(AText);
+  if (FText = nil) and (AText <> '') then
+  begin
+    inherited Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TConstant.Done                                                             }
+{****************************************************************************}
+destructor TConstant.Done;
+begin
+  DisposeStr(FText);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TConstant.SetText                                                          }
+{****************************************************************************}
+procedure TConstant.SetText (AText: string);
+begin
+  DisposeStr(FText);
+  FText := NewStr(AText);
+end;
+
+{****************************************************************************}
+{ TConstant.SetValue                                                         }
+{****************************************************************************}
+procedure TConstant.SetValue (AValue: string);
+var
+  N: Word;
+  ErrorCode: Integer;
+begin
+  Val(AValue,N,ErrorCode);
+  if ErrorCode = 0 then
+    Value := N;
+end;
+
+{****************************************************************************}
+{ TConstant.Text                                                             }
+{****************************************************************************}
+function TConstant.Text: string;
+begin
+  if (FText = nil) then
+    Text := ''
+  else Text := FText^;
+end;
+
+{****************************************************************************}
+{ TConstant.ValueAsString                                                    }
+{****************************************************************************}
+function TConstant.ValueAsString: string;
+var
+  S: string[5];
+begin
+  Str(Value,S);
+  ValueAsString := S;
+end;
+
+{****************************************************************************}
+{ TMemStringList Object                                                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TMemStringList.Init                                                        }
+{****************************************************************************}
+constructor TMemStringList.Init;
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := nil;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Load                                                        }
+{****************************************************************************}
+constructor TMemStringList.Load (var S: TStream);
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := New(PStringList,Load(S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Done                                                        }
+{****************************************************************************}
+destructor TMemStringList.Done;
+begin
+  if (StringList <> nil) then
+    Dispose(StringList,Done);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Compare                                                     }
+{****************************************************************************}
+function TMemStringList.Compare (Key1, Key2: Pointer): Sw_Integer;
+begin
+  if Word(Key1^) < Word(Key2^) then
+    Compare := -1
+  else Compare := Byte(Word(Key1^) > Word(Key2^));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Get                                                         }
+{****************************************************************************}
+function TMemStringList.Get (Key: Word): string;
+var
+  i: Sw_Integer;
+  S: string;
+begin
+  if (StringList = nil) then
+  begin  { started with Init, use in memory string list }
+    if Search(@Key,i) then
+      Get := PConstant(At(i))^.Text
+    else Get := '';
+  end
+  else begin
+    S := StringList^.Get(Key);
+    Get := S;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Insert                                                      }
+{****************************************************************************}
+procedure TMemStringList.Insert (Item: Pointer);
+var
+  i: Sw_Integer;
+begin
+  if (Item <> nil) then
+  begin
+    i := Count;
+    inherited Insert(Item);
+    if (i = Count) then  { collection expansion failed }
+      Dispose(PConstant(Item),Done);
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.KeyOf                                                       }
+{****************************************************************************}
+function TMemStringList.KeyOf (Item: Pointer): Pointer;
+begin
+  KeyOf := @(PConstant(Item)^.Value);
+end;
+
+{****************************************************************************}
+{ TMemStringList.LoadStrings                                                 }
+{****************************************************************************}
+function TMemStringList.LoadStrings: Sw_Integer;
+  procedure MakeEditableString (var Str: string);
+  const
+    SpecialChars: array[1..3] of Char = #3#10#13;
+  var
+    i, j: Byte;
+  begin
+    for i := 1 to 3 do
+      while (Pos(SpecialChars[i],Str) <> 0) do
+      begin
+        j := Pos(SpecialChars[i],Str);
+        System.Delete(Str,j,1);
+        case i of
+          1: System.Insert('#3',Str,j);
+          2: System.Insert('#10',Str,j);
+          3: System.Insert('#13',Str,j);
+        end;
+      end;
+  end;
+var
+  Constant: PConstant;
+  i: Word;
+  S: string;
+begin
+  LoadStrings := 0;
+  if (StringList = nil) then
+  begin
+    LoadStrings := 2;
+    Exit;
+  end;
+  for i := 0 to 65535 do
+  begin
+    S := StringList^.Get(i);
+    if (S <> '') then
+    begin
+      MakeEditableString(S);
+      Constant := NewConstant(i,S);
+      if LowMemory then
+      begin
+        if (Constant <> nil) then
+          Dispose(Constant,Done);
+        LoadStrings := 8;  { out of memory }
+        Exit;
+      end;
+      Insert(Constant);
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.NewConstant                                                 }
+{****************************************************************************}
+function TMemStringList.NewConstant (Value: Word; S: string): PConstant;
+begin
+  NewConstant := New(PConstant,Init(Value,S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Put                                                         }
+{****************************************************************************}
+procedure TMemStringList.Put (Key: Word; S: string);
+begin
+  Insert(New(PConstant,Init(Key,S)));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Store                                                       }
+{****************************************************************************}
+procedure TMemStringList.Store (var S: TStream);
+var
+  StrList: PStrListMaker;
+  Size: Word;
+  procedure Total (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  begin
+    with Constant^ do
+      Inc(Size,Succ(Length(Text)));
+  end;
+  procedure AddString (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  const
+    Numbers = ['0'..'9'];
+  var
+    i, j: Byte;
+    N: Byte;
+    ErrorCode: Integer;
+    S: string;
+  begin
+    with Constant^ do
+    begin
+        { convert formatting characters }
+      S := Text;
+      while (Pos('#',S) <> 0) do
+      begin
+        i := Succ(Pos('#',S));
+        j := i;
+        if (Length(S) > j) then
+          Inc(j,Byte(S[Succ(j)] in Numbers));
+        Val(Copy(S,i,j-i+1),N,ErrorCode);
+        System.Delete(S,Pred(i),j-i+2);
+        System.Insert(Char(N),S,Pred(i));
+      end;
+      StrList^.Put(Value,Text)
+    end;
+  end;
+begin
+  Size := 0;
+  ForEach(@Total);
+  StrList := New(PStrListMaker,Init(Size,Count * 6));
+  if (StrList = nil) then
+  begin
+    S.Status := 8;  { DOS error not enough memory }
+    Exit;
+  end;
+  ForEach(@AddString);
+  StrList^.Store(S);
+  Dispose(StrList,Done);
+end;
+
+{****************************************************************************}
+{                       Public Procedures and Functions                      }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Done                                                                       }
+{****************************************************************************}
+procedure DoneResource;
+begin
+  if (RezFile <> nil) then
+    begin
+      Dispose(RezFile,Done);
+      RezFile:=nil;
+    end;
+  if (Strings <> nil) then
+    begin
+      Dispose(Strings,Done);
+      Strings:=nil;
+    end;
+  if (Hints <> nil) then
+    begin
+      Dispose(Hints,Done);
+      Hints:=nil;
+    end;
+  if (Labels <> nil) then
+    begin
+      Dispose(Labels,Done);
+      Labels:=nil;
+    end;
+end;
+
+{****************************************************************************}
+{ Init                                                                       }
+{****************************************************************************}
+{$ifndef cdResource}
+
+{$I strtxt.inc}
+  { strtxt.inc contains the real strings and procedures InitRes... which
+    is converted from str.inc }
+
+function InitResource: Boolean;
+begin
+  InitResource := False;
+  Hints := New(PMemStringList,Init);
+  if (Hints = nil) then
+  begin
+    PrintStr('Fatal error.  Could not create Hints list.');
+    Exit;
+  end;
+  Strings := New(PMemStringList,Init);
+  if (Strings = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+  Labels := New(PMemStringList,Init);
+  if (Labels = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+{ now load the defaults }
+  InitResLabels;
+  InitResStrings;
+  InitResource := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ InitRezFile                                                                }
+{****************************************************************************}
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+var
+  Stream: PBufStream;
+  Result: Sw_Integer;
+begin
+  Stream := New(PBufStream,Init(AFile,Mode,RezBufferSize));
+  if (Stream = nil) then
+    Result := 2  { file not found; could also be out of memory }
+  else begin
+    AResFile := New(PResourceFile,Init(Stream));
+    if (AResFile = nil) then
+    begin
+      Dispose(Stream,Done);
+      Result := 11;
+    end
+    else Result := 0;
+  end;
+  InitRezFile := Result;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ Load                                                                       }
+{****************************************************************************}
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+var
+  Stream: PBufStream;
+begin
+  Load := False;
+  Stream := New(PBufStream,Init(AFile,stOpenRead,RezBufferSize));
+  if (Stream = nil) or (Stream^.Status <> 0) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not open resource file: ' + AFile);
+    Exit;
+  end;
+  RezFile := New(PResourceFile,Init(Stream));
+  if (RezFile = nil) then
+  begin
+    Dispose(Stream,Done);
+    Done;
+    PrintStr('Fatal error.  Could not initialize resource file.');
+    Exit;
+  end;
+  Hints := PStringList(RezFile^.Get(reHints));
+  if (Hints = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Hints string list.');
+    Exit;
+  end;
+  Strings := PStringList(RezFile^.Get(reStrings));
+  if (Strings = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Strings string list.');
+    Exit;
+  end;
+  Load := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ MergeLists                                                                 }
+{****************************************************************************}
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+var
+  Result: Sw_Integer;
+  procedure MoveItem (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  var
+    j: Sw_Integer;
+  begin
+    if (Result = 0) and (not Dest^.Search(Dest^.KeyOf(Constant),j)) then
+    begin
+      j := Dest^.Count;
+      Dest^.Insert(Constant);
+      if (j = Dest^.Count) then
+        Result := 8
+      else Source^.Delete(Constant);
+    end;
+  end;
+begin
+  if (Source = nil) or (Dest = nil) then
+  begin
+    MergeLists := 6;
+    Exit;
+  end;
+  Result := 0;
+  Source^.ForEach(@MoveItem);
+  MergeLists := Result;
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+
+begin
+  RezFile := nil;
+  Hints := nil;
+  Strings := nil;
+  Labels := nil;
+end.
+

+ 1402 - 0
fv/statuses.pas

@@ -0,0 +1,1402 @@
+{$V-}
+unit Statuses;
+
+{#Z+}
+{  Free Vision Status Objects Unit
+   Free VIsion
+   Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3   (96/04/13)
+  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+    Resume "aware"
+  - eliminated many bugs
+  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1    (95/12/6)
+   - minor typo corrections in opening unit documentation
+   - F+ to Z+ around stream registration records
+   - removed redundant sentence in TAppStatus definition
+   - updated CBarStatus documentation and constant
+   - removed TGauge.Init cross-reference from TSpinner.Init
+   - added THeapMemAvail and RegistertvStatus documentation
+   - numerous other documentation updates
+   - changed all calls to Send to Message
+
+1.2.0    (95/11/24)
+   - conversion to Bsd format
+
+1.1.0    (05/01/94)
+   - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+   - sdXXXX constants help documentation doesn't show TStatusDlg and
+     TMessageStatusDlg
+   - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+   - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
+respond to a new message event class, evStatus.  An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  ObjTypes, Objects, Drivers, Views, Dialogs,
+  Resource;
+
+const
+
+  evStatus = $8000;
+    { evStatus represents the event class all status views know how to
+      respond to. }
+    {#X Statuses }
+
+
+  CStatus    =  #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTStatus.CStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{              1    2    3
+           ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CStatus   º  1 ³  2 ³  3 º
+           ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÙ }
+{#F-}
+{#X TStatus }
+
+  CAppStatus =  #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTAppStatus.CAppStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{                 1    2    3
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TAppStatus }
+
+
+  CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTBarGauge.CBarGauge palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{                 1    2    3   4    5
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 ³ 16 ³ 19 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³    ³    ÀÄÄÄÄ filled in bar
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³    ÀÄÄÄÄÄÄÄÄÄ empty bar
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+Ý sdXXXX constants   (STDDLG unit) Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{    Constant      ³ Value ³ Meaning
+ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
+  sdNone          ³ $0000 ³ no buttons
+  sdCancelButton  ³ $0001 ³ show Cancel button
+  sdPauseButton   ³ $0002 ³ show Pause button
+  sdResumeButton  ³ $0004 ³ show Resume button
+  sdAllButtons    ³ $0008 ³ show Cancel, Pause and Resume
+                  ³       ³   buttons }
+{#Z+}
+  sdNone                 = $0000;
+  sdCancelButton         = $0001;
+  sdPauseButton          = $0002;
+  sdResumeButton         = $0004;
+  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+  {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+  SpinChars : String[4] = '³/Ä\';
+    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+      Only one character is displayed at a time.  The string is cycled
+      through then started over again until the view is disposed. }
+    {#X tvStatus }
+
+  sfPause = $F000;
+    { sfPause is an additional state flag used internally by status views to
+      indicate they are in a paused state and should not respond to their
+      command. }
+
+type
+  {#Z+}
+  PStatus = ^TStatus;
+  {#Z-}
+  TStatus = Object(TParamText)
+    { TStatus is the base object type from which all status views descend.
+      Status views are used to display information that will change at
+      run-time based upon some state or process in the application, such as
+      printing.
+
+      All status views that are to be inserted into the application should
+      descend from #TAppStatus# for proper color mapping. }
+    Command : Word;
+      { Command is the only command the status view will respond to.  When
+        the status view receives an evStatus event it checks the value of the
+        Event.Command field against Command before handling the event. }
+      {#X HandleEvent }
+    constructor Init (R : TRect; ACommand : Word; AText : String;
+                      AParamCount : Integer);
+      { Init calls the inherited constructor then sets #Command# to ACommand.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Command# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Store Init }
+    function Cancel : Boolean; virtual;
+      { Cancel should prompt the user when necessary for validation of
+        canceling the process which the status view is displaying.  If the
+        user elects to continue the process Cancel must return False,
+        otherwise Cancel must return True. }
+      {#X Pause Resume }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CStatus#. }
+      {#X TAppStatus CAppStatus }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent captures any #evStatus# messages with its command value
+        equal to #Command#, then calls #Update# with Data set to
+        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
+        view ignores the event. }
+    procedure Pause; virtual;
+      { Pause sends an evStatus message to the application with Event.Command
+        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        #Status# view's sfPause bit of the State flag is set by calling
+        SetState.  In the paused state, the status view does not respond to
+        its associated command. }
+      {#X Resume sdXXXX Cancel }
+    procedure Reset; virtual;
+      { Reset causes the status view to be reset to its beginning or default
+        value, then be redrawn.  Reset is used after an event is aborted
+        which can only be performed in its entirety. }
+    procedure Resume; virtual;
+      { Resume is called in response to pressing the Resume button.  Resume
+        sends an evStatus message to the application with Event.Command set
+        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        Status view's sfPause bit is turned off by calling SetState. }
+      {#X Pause sdXXXX Cancel }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Command# to the
+        stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes the status' displayed text as necessary based on
+        Data. }
+      {#X Command HandleEvent }
+  end;  { of TStatus }
+
+
+  {#Z+}
+  PStatusDlg = ^TStatusDlg;
+  {#Z-}
+  TStatusDlg = Object(TDialog)
+    { A TStatusDlg displays a status view and optional buttons.  It may be
+      used to display any status message and optionally provide end user
+      cancelation or pausing of an ongoing operation, such as printing.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    Status : PStatus;
+      { Status is the key status view for the dialog.  When a cmStatusPause
+        command is broadcast in response to pressing the pause button,
+        Event.InfoPtr is set to point to the command associated with Status. }
+      {#X TStatus cmXXXX }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+      { Init calls the inherited constructor to create the dialog and sets
+        the EventMask to handle #evStatus# events.  AStatus is assigned to
+        #Status# and inserted into the dialog at position 2,2.
+
+        The dialog is anchored at AStatus^.Origin and its size is at least
+        AStatus^.Size + 2 in both dimensions.  The actual size is determined
+        by the AFlags byte.  The #sdXXXX# constants should be used to signify
+        which buttons to display.
+
+        If an error occurs Init fails. }
+      {#X TStatus.Pause TStatus.Resume }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then loads #Status#.
+
+        If an error occurs Load fails. }
+      {#X Store }
+    procedure Cancel (ACommand : Word); virtual;
+      { Cancel sends an evStatus message to the Application object with
+        command set to cmCancel and InfoPtr set to the calling status view's
+        command, then calls the inherited Cancel method. }
+      {#X TBSDDialog.Cancel }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { All evStatus events are accepted by the dialog and sent to each
+        subview in Z-order until cleared.
+
+        If the dialog recieves an evCommand or evBroadcast event with the
+        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+        message to the Application variable with Event.Command set to the
+        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+        disposes of itself.
+
+        When a pause button is included, a cmStatusPause broadcast event is
+        associated with the button.  When the button is pressed a call to
+        #TStatus.Pause# results.  The status view is inactivated until it
+        receives an evStatus event with a commond of cmStatusResume and
+        Event.InfoPtr set to the status view's Command value.  When a pause
+        button is used, the application should respond to the evStatus event
+        (with Event.Command of cmStatusPause) appropriately, then dispatch a
+        cmStatusResume evStatus event when ready to resume activity. }
+      {#X TStatus.Command }
+    procedure InsertButtons (AFlags : Word); virtual;
+      { InsertButtons enlarges the dialog to the necessary size and inserts
+        the buttons specified in AFlags into the last row of the dialog. }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Status# to the
+        stream. }
+      {#X Load }
+  end;  { of TStatusDlg }
+
+
+  {#Z+}
+  PStatusMessageDlg = ^TStatusMessageDlg;
+  {#Z-}
+  TStatusMessageDlg = Object(TStatusDlg)
+    { A TStatusMessageDlg displays a message as static text with a status
+      view on the line below it.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+                      AMessage : String);
+      { Init calls the inherited constructor then inserts a TStaticText view
+        containing AMessage at the top line of the dialog.
+
+        The size of the dialog is determined by the size of the AStatus.  The
+        dialog is anchored at AStatus^.Origin and is of at least
+        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
+        are determined by AOptions.
+
+        AFlags contains flags which determine the buttons to be displayed
+        in the dialog.
+
+        If an error occurs Init fails. }
+  end;  { of TStatusMessageDlg }
+
+
+  {#Z+}
+  PGauge = ^TGauge;
+  {#Z-}
+  TGauge = Object(TStatus)
+    { A gauge is used to represent the current numerical position within a
+      range of values.  When Current equals Max a gauge dispatches an
+      #evStatus# event with the command set to cmStatusDone to the
+      Application object. }
+    Min : LongInt;
+      { Min is the minimum value which #Current# may be set to. }
+      {#X Max }
+    Max : LongInt;
+      { Max is the maximum value which #Current# may be set to. }
+      {#X Min }
+    Current : LongInt;
+      { Current is the current value represented in the gauge. }
+      {#X Max Min }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+      { Init calls the inherited constructor then sets #Min# and #Max# to
+        AMin and AMax, respectively.  #Current# is set to AMin.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Min#, #Max# and
+        #Current# from the stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX  Max = XXX  Current = XXX }
+{#F-}
+      { where XXX are the current values of the corresponding variables. }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+        of the gauge. }
+      {#X SetData }
+    procedure Reset; virtual;
+      { Reset sets #Current# to #Min# then redraws the status view. }
+      {#X TStatus.Reset }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+        accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Min#, #Max# and
+        #Current# to the stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments #Current#. }
+  end;  { of TGauge }
+
+
+  {#Z+}
+  PGaugeRec = ^TGaugeRec;
+  {#Z-}
+  TGaugeRec = record
+    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+    {#X TGauge.GetData TGauge.SetData }
+    Min, Max, Current : LongInt;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PArrowGauge = ^TArrowGauge;
+  {#Z-}
+  TArrowGauge = Object(TGauge)
+    { An arrow gauge draws a progressively larger series of arrows across the
+      view.  If Right is True, the arrows are right facing, '>', and are
+      drawn from left to right.  If Right is False, the arrows are left
+      facing, '<', and are drawn from right to left. }
+    Right : Boolean;
+      { Right determines the direction of arrow used and the direction which
+        the status view is filled.  If Right is True, the arrows are right
+        facing, '>', and are drawn from left to right.  If Right is False,
+        the arrows are left facing, '<', and are drawn from right to left. }
+      {#X Draw }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                      RightArrow : Boolean);
+      { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Right# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw fills the Current / Max percent of the view with arrows. }
+      {#X Right }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+        settings of the views variables. }
+      {#X SetData }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+        variables accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Right# to the
+        stream. }
+      {#X Load }
+  end;  { of TArrowGauge }
+
+
+  {#Z+}
+  PArrowGaugeRec = ^TArrowGaugeRec;
+  {#Z-}
+  TArrowGaugeRec = record
+    { A TArrowGaugeRec is used to set and get the variables of a
+      #TArrowGauge#. }
+    {#X TArrowGauge.GetData TArrowGauge.SetData }
+    Min, Max, Count : LongInt;
+    Right : Boolean;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PPercentGauge = ^TPercentGauge;
+  {#Z-}
+  TPercentGauge = Object(TGauge)
+    { A TPercentGauge displays a numerical percentage as returned by
+      #Percent# followed by a '%' sign. }
+    function Percent : Integer; virtual;
+      { Percent returns the whole number value of (Current / Max) * 100. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Draw; virtual;
+      { Draw writes the current percentage to the screen. }
+      {#X Percent }
+  end;  { of TPercentGauge }
+
+
+  {#Z+}
+  PBarGauge = ^TBarGauge;
+  {#Z-}
+  TBarGauge = Object(TPercentGauge)
+    { A TBarGauge displays a bar which increases in size from the left to
+      the right of the view as Current increases.  A numeric percentage
+      representing the value of (Current / Max) * 100 is displayed in the
+      center of the bar. }
+    {#x TPercentGauge.Percent }
+    procedure Draw; virtual;
+      { Draw draws the bar and percentage to the screen representing the
+        current status of the view's variables. }
+      {#X TGauge.Update }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CBarStatus#. }
+  end;  { of TBarGauge }
+
+
+  {#Z+}
+  PSpinnerGauge = ^TSpinnerGauge;
+  {#Z-}
+  TSpinnerGauge = Object(TGauge)
+    { A TSpinnerGauge displays a series of characters in one spot on the
+      screen giving the illusion of a spinning line. }
+    constructor Init (X, Y : Integer; ACommand : Word);
+      { Init calls the inherited constructor with AMin set to 0 and AMax set
+        to 4. }
+    procedure Draw; virtual;
+      { Draw uses the #SpinChars# variable to draw the view's Current
+        character. }
+      {#X Update }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+        is not generated when Current equals Max. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments Current until Current equals Max, when it resets
+        Current to Min. }
+      {#X Draw HandleEvent }
+  end;  { of TSpinnerGauge }
+
+
+  {#Z+}
+  PAppStatus = ^TAppStatus;
+  {#Z-}
+  TAppStatus = Object(TStatus)
+    { TAppStatus is a base object which implements color control for status
+      views that are normally inserted in the Application object. }
+    {#X TStatus }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default application status view
+        palette, #CAppStatus#. }
+      {#X TStatus CStatus }
+  end;  { of TAppStatus }
+
+
+  {#Z+}
+  PHeapMaxAvail = ^THeapMaxAvail;
+  {#Z-}
+  THeapMaxAvail = Object(TAppStatus)
+    { A THeapMaxAvail displays the largest available contiguous area of heap
+      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
+      comparing the result to #Max#, then updating the view if necessary. }
+    {#X THeapMemAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MaxAvail = xxxx
+
+        where xxxx is the result returned by MaxAvail. }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Max : LongInt;
+      { Max is the last reported value from MaxAvail. }
+      {#X Update }
+  end;  { of THeapMaxAvail }
+
+
+  {#Z+}
+  PHeapMemAvail = ^THeapMemAvail;
+  {#Z-}
+  THeapMemAvail = Object(TAppStatus)
+    { A THeapMemAvail displays the total amount of heap memory available to
+      the application.  It responds to a cmStatusUpdate event by calling
+      MemAvail and comparing the result to #Max#, then updating the view if
+      necessary. }
+    {#X THeapMaxAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MemAvail = xxxx
+
+        where xxxx is the result returned by MemAvail. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Mem : LongInt;
+      { Mem is the last available value reported by MemAvail. }
+      {#X Update }
+  end;  { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+  RStatus    : TStreamRec = (
+     ObjType : idStatus;
+     VmtLink : Ofs(TypeOf(TStatus)^);
+     Load    : @TStatus.Load;
+     Store   : @TStatus.Store);
+
+  RStatusDlg : TStreamRec = (
+     ObjType : idStatusDlg;
+     VmtLink : Ofs(TypeOf(TStatusDlg)^);
+     Load    : @TStatusDlg.Load;
+     Store   : @TStatusDlg.Store);
+
+  RStatusMessageDlg : TStreamRec = (
+     ObjType : idStatusMessageDlg;
+     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+     Load    : @TStatusMessageDlg.Load;
+     Store   : @TStatusMessageDlg.Store);
+
+  RGauge  : TStreamRec = (
+     ObjType : idGauge;
+     VmtLink : Ofs(TypeOf(TGauge)^);
+     Load    : @TGauge.Load;
+     Store   : @TGauge.Store);
+
+  RArrowGauge  : TStreamRec = (
+     ObjType : idArrowGauge;
+     VmtLink : Ofs(TypeOf(TArrowGauge)^);
+     Load    : @TArrowGauge.Load;
+     Store   : @TArrowGauge.Store);
+
+  RBarGauge  : TStreamRec = (
+     ObjType : idBarGauge;
+     VmtLink : Ofs(TypeOf(TBarGauge)^);
+     Load    : @TBarGauge.Load;
+     Store   : @TBarGauge.Store);
+
+  RPercentGauge  : TStreamRec = (
+     ObjType : idPercentGauge;
+     VmtLink : Ofs(TypeOf(TPercentGauge)^);
+     Load    : @TPercentGauge.Load;
+     Store   : @TPercentGauge.Store);
+
+  RSpinnerGauge  : TStreamRec = (
+     ObjType : idSpinnerGauge;
+     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+     Load    : @TSpinnerGauge.Load;
+     Store   : @TSpinnerGauge.Store);
+
+  RAppStatus  : TStreamRec = (
+     ObjType : idAppStatus;
+     VmtLink : Ofs(TypeOf(TAppStatus)^);
+     Load    : @TAppStatus.Load;
+     Store   : @TAppStatus.Store);
+
+  RHeapMinAvail  : TStreamRec = (
+     ObjType : idHeapMinAvail;
+     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+     Load    : @THeapMaxAvail.Load;
+     Store   : @THeapMaxAvail.Store);
+
+  RHeapMemAvail  : TStreamRec = (
+     ObjType : idHeapMemAvail;
+     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+     Load    : @THeapMemAvail.Load;
+     Store   : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+ÝRegisterStatuses procedure   (Statuses unit)Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+  { RegisterStatuses calls RegisterType for each of the status view and
+    status dialog object types defined in the tvStatus unit.  After calling
+    RegisterStatuses, your application can read or write any of those types
+    with streams. }
+
+
+implementation
+
+uses
+  FVConsts, MsgBox, App;
+
+{****************************************************************************}
+{                    Local procedures and functions                          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette                                                      }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object                                                         }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                              RightArrow : Boolean);
+begin
+  if not TGauge.Init(R,ACommand,AMin,AMax) then
+    Fail;
+  Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+  if not TGauge.Load(S) then
+    Fail;
+  S.Read(Right,SizeOf(Right));
+  if (S.Status <> stOk) then
+  begin
+    TGauge.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw                                                           }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of Char = '<>';
+var
+  B : TDrawBuffer;
+  C : Word;
+  Len : Byte;
+begin
+  C := GetColor(1);
+  Len := Round(Size.X * Current/(Max - Min));
+  MoveChar(B,' ',C,Size.X);
+  if Right then
+    MoveChar(B,Arrows[Byte(Right)],C,Len)
+  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+  WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+  PArrowGaugeRec(Rec)^.Min := Min;
+  PArrowGaugeRec(Rec)^.Max := Max;
+  PArrowGaugeRec(Rec)^.Count := Current;
+  PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+  Min := PArrowGaugeRec(Rec)^.Min;
+  Max := PArrowGaugeRec(Rec)^.Max;
+  Current := PArrowGaugeRec(Rec)^.Count;
+  Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store                                                          }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+  TGauge.Store(S);
+  S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw                                                             }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  FillSize : Word;
+  PercentDone : LongInt;
+  S : String[4];
+begin
+  { fill entire view }
+  MoveChar(B,' ',GetColor(4),Size.X);
+  { make progress bar }
+  C := GetColor(5);
+  FillSize := Round(Size.X * (Current / Max));
+  MoveChar(B,' ',C,FillSize);
+  { display percent done }
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  if PercentDone < 50 then
+    C := GetColor(4);
+  FillSize := (Size.X - Length(S)) div 2;
+  MoveStr(B[FillSize],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette                                                       }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+  S : String[Length(CBarGauge)] = CBarGauge;
+begin
+  GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object                                                              }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init                                                                }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+  if not TStatus.Init(R,ACommand,'',1) then
+    Fail;
+  Min := AMin;
+  Max := AMax;
+  Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load                                                                }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+  if not TStatus.Load(S) then
+    Fail;
+  S.Read(Min,SizeOf(Min));
+  S.Read(Max,SizeOf(Max));
+  S.Read(Current,SizeOf(Current));
+  if S.Status <> stOk then
+  begin
+    TStatus.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw                                                                }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+  S : String;
+  B : TDrawBuffer;
+begin
+  { Blank the gauge }
+  MoveChar(B,' ',GetColor(1),Size.X);
+  WriteBuf(0,0,Size.X,Size.Y,B);
+  { write current status }
+  FormatStr(S,'%d',Current);
+  MoveStr(B,S,GetColor(1));
+  WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData                                                             }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+  TGaugeRec(Rec).Min := Min;
+  TGaugeRec(Rec).Max := Max;
+  TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset                                                               }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+  Current := Min;
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData                                                             }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+  Min := TGaugeRec(Rec).Min;
+  Max := TGaugeRec(Rec).Max;
+  Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store                                                               }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+  TStatus.Store(S);
+  S.Write(Min,SizeOf(Min));
+  S.Write(Max,SizeOf(Max));
+  S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update                                                              }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+  if Current < Max then
+  begin
+    Inc(Current);
+    DrawView;
+  end
+  else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+    Fail;
+  Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+  M : LongInt;
+begin
+  M := MaxAvail;
+  if (Max <> M) then
+  begin
+    Max := MaxAvail;
+    SetData(Max);
+  end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+    Fail;
+  Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+  { Total bytes available on the heap.  May not be contiguous. }
+var
+  M : LongInt;
+begin
+  M := MemAvail;
+  if (Mem <> M) then
+  begin
+    Mem := M;
+    SetData(Mem);
+  end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw                                                         }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  S : String;
+  PercentDone : LongInt;
+  FillSize : Integer;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent                                                      }
+{****************************************************************************}
+function TPercentGauge.Percent : Integer;
+  { Returns percent as a whole integer Current of Max }
+begin
+  Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object                                                       }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init                                                         }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
+var R : TRect;
+begin
+  R.Assign(X,Y,X+1,Y+1);
+  if not TGauge.Init(R,ACommand,1,4) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw                                                         }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent                                                  }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+  TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update                                                       }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+  if Current = Max then
+    Current := Min
+  else Inc(Current);
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object                                                             }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init                                                               }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+                          AParamCount : Integer);
+begin
+  if (not TParamText.Init(R,AText,AParamCount)) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load                                                               }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+  if not TParamText.Load(S) then
+    Fail;
+  S.Read(Command,SizeOf(Command));
+  if (S.Status <> stOk) then
+  begin
+    TParamText.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel                                                             }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+  Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette                                                         }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+  P : String[Length(CStatus)] = CStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent                                                        }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+  begin
+    Pause;
+    ClearEvent(Event);
+  end;
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if (Event.InfoPtr = @Self) then
+          begin
+            Message(Owner,evStatus,cmStatusDone,@Self);
+            ClearEvent(Event);
+          end;
+        cmStatusUpdate :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Update(Event.InfoPtr);
+            { ClearEvent(Event); } { don't clear the event so multiple }
+                            { status views can respond to the same event }
+          end;
+        cmStatusResume :
+          if (Event.InfoWord = Command) and
+             ((State and sfPause) = sfPause) then
+          begin
+            Resume;
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Pause;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause                                                              }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+  SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset                                                              }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume                                                             }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+  SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store                                                              }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+  TParamText.Store(S);
+  S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update                                                             }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+  DisposeStr(Text);
+  Text := NewStr(String(Data^));
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                             AFlags : Word);
+var
+  R : TRect;
+  i : LongInt;
+  Buttons : Byte;
+begin
+  if (AStatus = nil) then
+    Fail;
+  R.A := AStatus^.Origin;
+  R.B := AStatus^.Size;
+  Inc(R.B.Y,R.A.Y+4);
+  Inc(R.B.X,R.A.X+5);
+  if not TDialog.Init(R,ATitle) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Status := AStatus;
+  Status^.MoveTo(2,2);
+  Insert(Status);
+  InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  GetSubViewPtr(S,Status);
+  if (S.Status <> stOk) then
+  begin
+    if (Status <> nil) then
+      Dispose(Status,Done);
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel                                                          }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+  if Status^.Cancel then
+    TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent                                                     }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if Event.InfoPtr = Status then
+          begin
+            TDialog.Cancel(cmOk);
+            ClearEvent(Event);
+          end;
+      end;
+      { else let TDialog.HandleEvent send to all subviews for handling }
+    evBroadcast, evCommand :
+      case Event.Command of
+        cmCancel, cmClose :
+          begin
+            Cancel(cmCancel);
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          begin
+            Status^.Pause;
+            ClearEvent(Event);
+          end;
+        cmStatusResume :
+          begin
+            Status^.Resume;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons                                                   }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+  R : TRect;
+  P : PButton;
+  Buttons : Byte;
+  X, Y, Gap : Integer;
+  i : Word;
+begin
+  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+  { do this Inc twice, once for Pause and once for Resume buttons }
+  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+  if Buttons > 0 then
+  begin
+    Status^.GrowMode := gfGrowHiX;
+    { resize dialog to hold all requested buttons }
+    if Size.X < ((Buttons * 12) + 2) then
+      GrowTo((Buttons * 12) + 2,Size.Y + 2)
+    else GrowTo(Size.X,Size.Y + 2);
+    { find correct starting position for first button }
+    Gap := Size.X - (Buttons * 10) - 2;
+    Gap := Gap div Succ(Buttons);
+    X := Gap;
+    if X < 2 then
+      X := 2;
+    Y := Size.Y - 3;
+    { insert buttons }
+    if ((AFlags and sdCancelButton) = sdCancelButton) then
+    begin
+      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+    end;
+    if ((AFlags and sdPauseButton) = sdPauseButton) then
+    begin
+      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+                     bfBroadcast);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+    end;
+  end;  { of if }
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store                                                           }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object                                                   }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init                                                     }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                                    AFlags : Word; AMessage : String);
+var
+  P : PStaticText;
+  X, Y : Integer;
+  R : TRect;
+begin
+  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+    Fail;
+  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+  GetExtent(R);
+  X := R.B.X - R.A.X;
+  if X < Size.X then
+    X := Size.X;
+  Y := R.B.Y - R.A.Y;
+  if Y < Size.Y then
+    Y := Size.Y;
+  GrowTo(X,Y);
+  R.Assign(2,2,Size.X-2,Size.Y-3);
+  P := New(PStaticText,Init(R,AMessage));
+  if (P = nil) then
+  begin
+    TStatusDlg.Done;
+    Fail;
+  end;
+  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+  Insert(P);
+end;
+
+{****************************************************************************}
+{                    Global procedures and functions                         }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses                                                           }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{  RegisterType(RStatus);
+  RegisterType(RStatusDlg);
+  RegisterType(RGauge);
+  RegisterType(RArrowGauge);
+  RegisterType(RPercentGauge);
+  RegisterType(RBarGauge);
+  RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+begin
+end.

+ 2686 - 0
fv/stddlg.pas

@@ -0,0 +1,2686 @@
+{*******************************************************}
+{ Free Vision Runtime Library                           }
+{ StdDlg Unit                                           }
+{ Version: 0.1.0                                        }
+{ Release Date: July 23, 1998                           }
+{                                                       }
+{*******************************************************}
+{                                                       }
+{ This unit is a port of Borland International's        }
+{ StdDlg.pas unit.  It is for distribution with the     }
+{ Free Pascal (FPK) Compiler as part of the 32-bit      }
+{ Free Vision library.  The unit is still fully         }
+{ functional under BP7 by using the tp compiler         }
+{ directive when rebuilding the library.                }
+{                                                       }
+{*******************************************************}
+
+{ Revision History
+
+1.1a   (97/12/29)
+  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
+    able to have an action taken automatically when the FileList was
+    selected and kbEnter pressed
+
+1.1
+  - modified OpenNewFile to take a history list ID
+  - implemented OpenNewFile
+
+1.0   (1992)
+  - original implementation }
+
+unit StdDlg;
+
+{
+  This unit has been modified to make some functions global, apply patches
+  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
+  several new global functions and procedures.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+{$ifdef OS_DOS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_WINDOWS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_OS2}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+
+interface
+
+uses
+  ObjTypes, Objects, Drivers, Views, Dialogs, Validate, Dos;
+
+const
+{$ifdef PPC_FPC}
+  MaxDir   = 255;   { Maximum length of a DirStr. }
+  MaxFName = 255; { Maximum length of a FNameStr. }
+
+  {$ifdef OS_LINUX}
+  DirSeparator : Char = '/';
+  {$else}
+  DirSeparator : Char = '\';
+  {$endif}
+
+{$else}
+  MaxDir = 67;   { Maximum length of a DirStr. }
+  MaxFName = 79; { Maximum length of a FNameStr. }
+  DirSeparator: Char = '\';
+{$endif}
+
+
+type
+  { TSearchRec }
+
+  {  Record used to store directory information by TFileDialog
+     This is a part of Dos.Searchrec for Bp !! }
+
+  TSearchRec = packed record
+    Attr: Longint;
+    Time: Longint;
+    Size: Longint;
+{$ifdef PPC_FPC}
+    Name: string[255];
+{$else not PPC_FPC}
+    Name: string[12];
+{$endif not PPC_FPC}
+  end;
+  PSearchRec = ^TSearchRec;
+
+type
+
+  { TFileInputLine is a special input line that is used by      }
+  { TFileDialog that will update its contents in response to a  }
+  { cmFileFocused command from a TFileList.          }
+
+  PFileInputLine = ^TFileInputLine;
+  TFileInputLine = object(TInputLine)
+    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileCollection is a collection of TSearchRec's. }
+
+  PFileCollection = ^TFileCollection;
+  TFileCollection = object(TSortedCollection)
+    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  {#Z+}
+  PFileValidator = ^TFileValidator;
+  {#Z-}
+  TFileValidator = Object(TValidator)
+  end;  { of TFileValidator }
+
+  { TSortedListBox is a TListBox that assumes it has a     }
+  { TStoredCollection instead of just a TCollection.  It will   }
+  { perform an incremental search on the contents.       }
+
+  PSortedListBox = ^TSortedListBox;
+  TSortedListBox = object(TListBox)
+    SearchPos: Byte;
+    ShiftState: Byte;
+    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
+      AScrollBar: PScrollBar);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure NewList(AList: PCollection); virtual;
+  end;
+
+  { TFileList is a TSortedList box that assumes it contains     }
+  { a TFileCollection as its collection.  It also communicates  }
+  { through broadcast messages to TFileInput and TInfoPane      }
+  { what file is currently selected.             }
+
+  PFileList = ^TFileList;
+  TFileList = object(TSortedListBox)
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function DataSize: Sw_Word; virtual;
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    procedure GetData(var Rec); virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure ReadDirectory(AWildCard: PathStr);
+    procedure SetData(var Rec); virtual;
+  end;
+
+  { TFileInfoPane is a TView that displays the information      }
+  { about the currently selected file in the TFileList     }
+  { of a TFileDialog.                  }
+
+  PFileInfoPane = ^TFileInfoPane;
+  TFileInfoPane = object(TView)
+    S: TSearchRec;
+    constructor Init(var Bounds: TRect);
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileDialog is a standard file name input dialog      }
+
+  TWildStr = PathStr;
+
+const
+  fdOkButton      = $0001;      { Put an OK button in the dialog }
+  fdOpenButton    = $0002;      { Put an Open button in the dialog }
+  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
+  fdClearButton   = $0008;      { Put a Clear button in the dialog }
+  fdHelpButton    = $0010;      { Put a Help button in the dialog }
+  fdNoLoadDir     = $0100;      { Do not load the current directory }
+            { contents into the dialog at Init. }
+            { This means you intend to change the }
+            { WildCard by using SetData or store }
+            { the dialog on a stream. }
+
+type
+
+  PFileHistory = ^TFileHistory;
+  TFileHistory = object(THistory)
+    CurDir : PString;
+    procedure HandleEvent(var Event: TEvent);virtual;
+    destructor Done; virtual;
+    procedure AdaptHistoryToDir(Dir : string);
+  end;
+
+  PFileDialog = ^TFileDialog;
+  TFileDialog = object(TDialog)
+    FileName: PFileInputLine;
+    FileList: PFileList;
+    FileHistory: PFileHistory;
+    WildCard: TWildStr;
+    Directory: PString;
+    constructor Init(AWildCard: TWildStr; const ATitle,
+      InputName: String; AOptions: Word; HistoryId: Byte);
+    constructor Load(var S: TStream);
+    destructor Done; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure GetFileName(var S: PathStr);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure ReadDirectory;
+  end;
+
+  { TDirEntry }
+
+  PDirEntry = ^TDirEntry;
+  TDirEntry = record
+    DisplayText: PString;
+    Directory: PString;
+  end;  { of TDirEntry }
+
+  { TDirCollection is a collection of TDirEntry's used by       }
+  { TDirListBox.                 }
+
+  PDirCollection = ^TDirCollection;
+  TDirCollection = object(TCollection)
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  { TDirListBox displays a tree of directories for use in the }
+  { TChDirDialog.                    }
+
+  PDirListBox = ^TDirListBox;
+  TDirListBox = object(TListBox)
+    Dir: DirStr;
+    Cur: Word;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function IsSelected(Item: Sw_Integer): Boolean; virtual;
+    procedure NewDirectory(var ADir: DirStr);
+    procedure SetState(AState: Word; Enable: Boolean); virtual;
+  end;
+
+  { TChDirDialog is a standard change directory dialog. }
+
+const
+  cdNormal     = $0000; { Option to use dialog immediately }
+  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
+  cdHelpButton = $0002; { Put a help button in the dialog }
+
+type
+
+  PChDirDialog = ^TChDirDialog;
+  TChDirDialog = object(TDialog)
+    DirInput: PInputLine;
+    DirList: PDirListBox;
+    OkButton: PButton;
+    ChDirButton: PButton;
+    constructor Init(AOptions: Word; HistoryId: Sw_Word);
+    constructor Load(var S: TStream);
+    function DataSize: Sw_Word; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure SetUpDialog;
+  end;
+
+  PEditChDirDialog = ^TEditChDirDialog;
+  TEditChDirDialog = Object(TChDirDialog)
+    { TEditChDirDialog allows setting/getting the starting directory.  The
+      transfer record is a DirStr. }
+    function DataSize : Sw_Word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+  end;  { of TEditChDirDialog }
+
+
+  {#Z+}
+  PDirValidator = ^TDirValidator;
+  {#Z-}
+  TDirValidator = Object(TFilterValidator)
+    constructor Init;
+    function IsValid(const S: string): Boolean; virtual;
+    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+      virtual;
+  end;  { of TDirValidator }
+
+
+  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
+    { Functions of type FileConfirmFunc's are used to prompt the end user for
+      confirmation of an operation.
+
+      FileConfirmFunc's should ask the user whether to perform the desired
+      action on the file named AFile.  If the user elects to perform the
+      function FileConfirmFunc's return True, otherwise they return False.
+
+      Using FileConfirmFunc's allows routines to be coded independant of the
+      user interface implemented.  OWL and TurboVision are supported through
+      conditional defines.  If you do not use either user interface you must
+      compile this unit with the conditional define cdNoMessages and set all
+      FileConfirmFunc variables to a valid function prior to calling any
+      routines in this unit. }
+    {#X ReplaceFile DeleteFile }
+
+
+var
+
+  ReplaceFile : FileConfirmFunc;
+    { ReplaceFile returns True if the end user elects to replace the existing
+      file with the new file, otherwise it returns False.
+
+      ReplaceFile is only called when #CheckOnReplace# is True. }
+    {#X DeleteFile }
+
+  DeleteFile : FileConfirmFunc;
+    { DeleteFile returns True if the end user elects to delete the file,
+      otherwise it returns False.
+
+       DeleteFile is only called when #CheckOnDelete# is True. }
+    {#X ReplaceFile }
+
+
+const
+
+  CInfoPane = #30;
+
+  { TStream registration records }
+
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+
+function DriveValid(Drive: Char): Boolean;
+  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
+    by attempting to change the current directory to Drive, then restoring
+    the original directory. }
+
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+
+function ExtractFileName(AFile: FNameStr): NameStr;
+  { ExtractFileName returns the file name without any directory or file
+    extension information. }
+
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
+    case-insensitive. }
+
+function FileExists (AFile : FNameStr) : Boolean;
+  { FileExists looks for the file specified in AFile.  If AFile is present
+    FileExists returns true, otherwise FileExists returns False.
+
+    The search is performed relative to the current system directory, but
+    other directories may be searched by prefacing a file name with a valid
+    directory path.
+
+    There is no check for a vaild file name or drive.  Errrors are handled
+    internally and not reported in DosError.  Critical errors are left to
+    the system's critical error handler. }
+  {#X OpenFile }
+
+function GetCurDir: DirStr;
+  { GetCurDir returns the current directory.  The directory returned always
+    ends with a trailing backslash '\'. }
+
+function GetCurDrive: Char;
+  { GetCurDrive returns the letter of the current drive as reported by the
+    operating system. }
+
+function IsWild(const S: String): Boolean;
+  { IsWild returns True if S contains a question mark (?) or asterix (*). }
+
+function IsList(const S: String): Boolean;
+  { IsList returns True if S contains list separator (;) char }
+
+function IsDir(const S: String): Boolean;
+  { IsDir returns True if S is a valid DOS directory. }
+
+procedure MakeResources;
+  { MakeResources places a language specific version of all resources
+    needed for the StdDlg unit to function on the RezFile using the string
+    constants and variables in the Resource unit.  The Resource unit and the
+    appropriate string lists must be initialized prior to calling this
+    procedure. }
+
+function NoWildChars(S: String): String;
+  { NoWildChars deletes the wild card characters ? and * from the string S
+    and returns the result. }
+
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+  { OpenFile prompts the user to select a file using the file specifications
+    in AFile as the starting file and path.  Wildcards are accepted.  If the
+    user accepts a file OpenFile returns True, otherwise OpenFile returns
+    False.
+
+    Note: The file returned may or may not exist. }
+
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+
+function PathValid(var Path: PathStr): Boolean;
+  { PathValid returns True if Path is a valid DOS path name.  Path may be a
+    file or directory name.  Trailing '\'s are removed. }
+
+procedure RegisterStdDlg;
+  { RegisterStdDlg registers all objects in the StdDlg unit for stream
+    usage. }
+
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+  { SaveAs prompts the user for a file name using AFile as a template.  If
+    AFile already exists and CheckOnReplace is True, the user is prompted
+    to replace the file.
+
+    If a valid file name is entered SaveAs returns True, other SaveAs returns
+    False. }
+
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+  { SelectDir prompts the user to select a directory using ADir as the
+    starting directory.  If a directory is selected, SelectDir returns True.
+    The directory returned is gauranteed to exist. }
+
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+  { ShrinkPath returns a file name with a maximu length of MaxLen.
+    Internal directories are removed and replaced with elipses as needed to
+    make the file name fit in MaxLen.
+
+    AFile must be a valid path name. }
+
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+  { StdDeleteFile returns True if the end user elects to delete the file,
+    otherwise it returns False.
+
+    DeleteFile is only called when CheckOnDelete is True. }
+
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+  { StdReplaceFile returns True if the end user elects to replace the existing
+    AFile with the new AFile, otherwise it returns False.
+
+    ReplaceFile is only called when CheckOnReplace is True. }
+
+function ValidFileName(var FileName: PathStr): Boolean;
+  { ValidFileName returns True if FileName is a valid DOS file name. }
+
+
+const
+  CheckOnReplace : Boolean = True;
+    { CheckOnReplace is used by file functions.  If a file exists, it is
+      optionally replaced based on the value of CheckOnReplace.
+
+      If CheckOnReplace is False the file is replaced without asking the
+      user.  If CheckOnReplace is True, the end user is asked to replace the
+      file using a call to ReplaceFile.
+
+      CheckOnReplace is set to True by default. }
+
+  CheckOnDelete : Boolean = True;
+    { CheckOnDelete is used by file and directory functions.  If a file
+      exists, it is optionally deleted based on the value of CheckOnDelete.
+
+      If CheckOnDelete is False the file or directory is deleted without
+      asking the user.  If CheckOnDelete is True, the end user is asked to
+      delete the file/directory using a call to DeleteFile.
+
+      CheckOnDelete is set to True by default. }
+
+
+
+const
+  RFileInputLine: TStreamRec = (
+     ObjType: idFileInputLine;
+     VmtLink: Ofs(TypeOf(TFileInputLine)^);
+     Load:    @TFileInputLine.Load;
+     Store:   @TFileInputLine.Store
+  );
+
+  RFileCollection: TStreamRec = (
+     ObjType: idFileCollection;
+     VmtLink: Ofs(TypeOf(TFileCollection)^);
+     Load:    @TFileCollection.Load;
+     Store:   @TFileCollection.Store
+  );
+
+  RFileList: TStreamRec = (
+     ObjType: idFileList;
+     VmtLink: Ofs(TypeOf(TFileList)^);
+     Load:    @TFileList.Load;
+     Store:   @TFileList.Store
+  );
+
+  RFileInfoPane: TStreamRec = (
+     ObjType: idFileInfoPane;
+     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
+     Load:    @TFileInfoPane.Load;
+     Store:   @TFileInfoPane.Store
+  );
+
+  RFileDialog: TStreamRec = (
+     ObjType: idFileDialog;
+     VmtLink: Ofs(TypeOf(TFileDialog)^);
+     Load:    @TFileDialog.Load;
+     Store:   @TFileDialog.Store
+  );
+
+  RDirCollection: TStreamRec = (
+     ObjType: idDirCollection;
+     VmtLink: Ofs(TypeOf(TDirCollection)^);
+     Load:    @TDirCollection.Load;
+     Store:   @TDirCollection.Store
+  );
+
+  RDirListBox: TStreamRec = (
+     ObjType: idDirListBox;
+     VmtLink: Ofs(TypeOf(TDirListBox)^);
+     Load:    @TDirListBox.Load;
+     Store:   @TDirListBox.Store
+  );
+
+  RChDirDialog: TStreamRec = (
+     ObjType: idChDirDialog;
+     VmtLink: Ofs(TypeOf(TChDirDialog)^);
+     Load:    @TChDirDialog.Load;
+     Store:   @TChDirDialog.Store
+  );
+
+  RSortedListBox: TStreamRec = (
+     ObjType: idSortedListBox;
+     VmtLink: Ofs(TypeOf(TSortedListBox)^);
+     Load:    @TSortedListBox.Load;
+     Store:   @TSortedListBox.Store
+  );
+
+  REditChDirDialog : TStreamRec = (
+    ObjType : idEditChDirDialog;
+    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
+    Load    : @TEditChDirDialog.Load;
+    Store   : @TEditChDirDialog.Store);
+
+
+implementation
+
+{****************************************************************************}
+{            Local Declarations              }
+{****************************************************************************}
+
+uses
+  FVConsts, App, Memory, HistList, MsgBox, Resource;
+
+type
+
+  PStringRec = record
+    { PStringRec is needed for properly displaying PStrings using
+      MessageBox. }
+    AString : PString;
+  end;
+
+{****************************************************************************}
+{ TDirValidator Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TDirValidator.Init                    }
+{****************************************************************************}
+constructor TDirValidator.Init;
+const   { What should this list be?  The commented one doesn't allow home,
+  end, right arrow, left arrow, Ctrl+XXXX, etc. }
+  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
+{  Chars: TCharSet = [#0..#255]; }
+begin
+  Chars := Chars + [DirSeparator];
+  if not inherited Init(Chars) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValid                      }
+{****************************************************************************}
+function TDirValidator.IsValid(const S: string): Boolean;
+begin
+{  IsValid := False; }
+  IsValid := True;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValidInput                  }
+{****************************************************************************}
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+begin
+{  IsValid := False; }
+  IsValidInput := True;
+end;
+
+{****************************************************************************}
+{ TFileInputLine Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInputLine.Init                     }
+{****************************************************************************}
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+begin
+  TInputLine.Init(Bounds, AMaxLen);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInputLine.HandleEvent                  }
+{****************************************************************************}
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
+begin
+  TInputLine.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
+    (State and sfSelected = 0) then
+  begin
+     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
+       begin
+          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
+            PFileDialog(Owner)^.WildCard;
+          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
+              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
+       end
+     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
+     DrawView;
+  end;
+end;
+
+{****************************************************************************}
+{ TFileCollection Object                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileCollection.Compare                     }
+{****************************************************************************}
+  function uppername(const s : string) : string;
+  var
+    i  : Sw_integer;
+    in_name : boolean;
+  begin
+     in_name:=true;
+     for i:=length(s) downto 1 do
+      if in_name and (s[i] in ['a'..'z']) then
+        uppername[i]:=char(byte(s[i])-32)
+      else
+       begin
+          uppername[i]:=s[i];
+          if s[i] = DirSeparator then
+            in_name:=false;
+       end;
+     uppername[0]:=s[0];
+  end;
+
+function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
+  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
+  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
+  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
+     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
+  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
+     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
+{$ifdef linux}
+  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
+{$else linux}
+  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
+{$endif def linux}
+    Compare := 1
+  else Compare := -1;
+end;
+
+{****************************************************************************}
+{ TFileCollection.FreeItem                   }
+{****************************************************************************}
+procedure TFileCollection.FreeItem(Item: Pointer);
+begin
+  Dispose(PSearchRec(Item));
+end;
+
+{****************************************************************************}
+{ TFileCollection.GetItem                     }
+{****************************************************************************}
+function TFileCollection.GetItem(var S: TStream): Pointer;
+var
+  Item: PSearchRec;
+begin
+  New(Item);
+  S.Read(Item^, SizeOf(TSearchRec));
+  GetItem := Item;
+end;
+
+{****************************************************************************}
+{ TFileCollection.PutItem                     }
+{****************************************************************************}
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
+begin
+  S.Write(Item^, SizeOf(TSearchRec));
+end;
+
+
+{*****************************************************************************
+               TFileList
+*****************************************************************************}
+
+const
+  ListSeparator=';';
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : Sw_integer;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=char(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : Sw_integer;
+  begin
+    i1:=0;
+    i2:=0;
+    if hstr1='' then
+      begin
+        CmpStr:=(hstr2='');
+        exit;
+      end;
+    found:=true;
+    repeat
+      if found then
+       inc(i2);
+      inc(i1);
+      case hstr1[i1] of
+        '?' :
+          found:=true;
+        '*' :
+          begin
+            found:=true;
+            if (i1=length(hstr1)) then
+             i2:=length(hstr2)
+            else
+             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+              begin
+                if i2<length(hstr2) then
+                 dec(i1)
+              end
+            else
+             if i2>1 then
+              dec(i2);
+          end;
+        else
+          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+      end;
+    until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
+    if found then
+      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef linux}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+function MatchesMaskList(What, MaskList: string): boolean;
+var P: integer;
+    Match: boolean;
+begin
+  Match:=false;
+  if What<>'' then
+  repeat
+    P:=Pos(ListSeparator, MaskList);
+    if P=0 then P:=length(MaskList)+1;
+    Match:=MatchesMask(What,copy(MaskList,1,P-1));
+    Delete(MaskList,1,P);
+  until Match or (MaskList='');
+  MatchesMaskList:=Match;
+end;
+
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  TSortedListBox.Init(Bounds, 2, AScrollBar);
+end;
+
+destructor TFileList.Done;
+begin
+  if List <> nil then Dispose(List, Done);
+  TListBox.Done;
+end;
+
+function TFileList.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+procedure TFileList.FocusItem(Item: Sw_Integer);
+begin
+  TSortedListBox.FocusItem(Item);
+  if (List^.Count > 0) then
+    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
+end;
+
+procedure TFileList.GetData(var Rec);
+begin
+end;
+
+function TFileList.GetKey(var S: String): Pointer;
+const
+  SR: TSearchRec = ();
+
+procedure UpStr(var S: String);
+var
+  I: Sw_Integer;
+begin
+  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
+end;
+
+begin
+  if (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
+    SR.Attr := Directory
+  else SR.Attr := 0;
+  SR.Name := S;
+{$ifndef linux}
+  UpStr(SR.Name);
+{$endif linux}
+  GetKey := @SR;
+end;
+
+function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
+var
+  S: String;
+  SR: PSearchRec;
+begin
+  SR := PSearchRec(List^.At(Item));
+  S := SR^.Name;
+  if SR^.Attr and Directory <> 0 then
+  begin
+    S[Length(S)+1] := DirSeparator;
+    Inc(S[0]);
+  end;
+  GetText := S;
+end;
+
+procedure TFileList.HandleEvent(var Event: TEvent);
+var
+  S : String;
+  K : pointer;
+  Value : Sw_integer;
+begin
+  if (Event.What = evMouseDown) and (Event.Double) then
+  begin
+    Event.What := evCommand;
+    Event.Command := cmOK;
+    PutEvent(Event);
+    ClearEvent(Event);
+  end
+  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
+  begin
+    { select '..' }
+      S := '..';
+      K := GetKey(S);
+      If PSortedCollection(List)^.Search(K, Value) then
+        FocusItem(Value);
+  end
+  else TSortedListBox.HandleEvent(Event);
+end;
+
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
+const
+  FindAttr = ReadOnly + Archive;
+{$ifdef linux}
+  AllFiles = '*';
+{$else}
+  AllFiles = '*.*';
+{$endif}
+  PrevDir  = '..';
+var
+  S: SearchRec;
+  P: PSearchRec;
+  FileList: PFileCollection;
+  NumFiles: Word;
+  FindStr,
+  WildName : string;
+  Dir: DirStr;
+  Ext: ExtStr;
+  Name: NameStr;
+  Event : TEvent;
+  Tmp: PathStr;
+begin
+  NumFiles := 0;
+  FileList := New(PFileCollection, Init(5, 5));
+  AWildCard := FExpand(AWildCard);
+  FSplit(AWildCard, Dir, Name, Ext);
+  if pos(ListSeparator,AWildCard)>0 then
+   begin
+     WildName:=Copy(AWildCard,length(Dir)+1,255);
+     FindStr:=Dir+AllFiles;
+   end
+  else
+   begin
+     WildName:=Name+Ext;
+     FindStr:=AWildCard;
+   end;
+  FindFirst(FindStr, FindAttr, S);
+  P := PSearchRec(@P);
+  while assigned(P) and (DosError = 0) do
+   begin
+     if (S.Attr and Directory = 0) and
+        MatchesMaskList(S.Name,WildName) then
+     begin
+       P := MemAlloc(SizeOf(P^));
+       if assigned(P) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+         FileList^.Insert(P);
+       end;
+     end;
+     FindNext(S);
+   end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+
+  Tmp := Dir + AllFiles;
+  FindFirst(Tmp, Directory, S);
+  while (P <> nil) and (DosError = 0) do
+  begin
+    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
+    begin
+      P := MemAlloc(SizeOf(P^));
+      if P <> nil then
+      begin
+        P^.Attr:=S.Attr;
+        P^.Time:=S.Time;
+        P^.Size:=S.Size;
+        P^.Name:=S.Name;
+        FileList^.Insert(P);
+      end;
+    end;
+    FindNext(S);
+  end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+ {$ifndef linux}
+  if Length(Dir) > 4 then
+ {$endif not linux}
+  begin
+    P := MemAlloc(SizeOf(P^));
+    if P <> nil then
+    begin
+      FindFirst(Tmp, Directory, S);
+      FindNext(S);
+      if (DosError = 0) and (S.Name = PrevDir) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+       end
+      else
+       begin
+         P^.Name := PrevDir;
+         P^.Size := 0;
+         P^.Time := $210000;
+         P^.Attr := Directory;
+       end;
+      FileList^.Insert(PSearchRec(P));
+     {$ifdef fpc}
+      FindClose(S);
+     {$endif}
+    end;
+  end;
+  if P = nil then
+    MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
+  NewList(FileList);
+  if List^.Count > 0 then
+  begin
+    Event.What := evBroadcast;
+    Event.Command := cmFileFocused;
+    Event.InfoPtr := List^.At(0);
+    Owner^.HandleEvent(Event);
+  end;
+end;
+
+procedure TFileList.SetData(var Rec);
+begin
+  with PFileDialog(Owner)^ do
+    Self.ReadDirectory(Directory^ + WildCard);
+end;
+
+{****************************************************************************}
+{ TFileInfoPane Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInfoPane.Init                    }
+{****************************************************************************}
+constructor TFileInfoPane.Init(var Bounds: TRect);
+begin
+  TView.Init(Bounds);
+  FillChar(S,SizeOf(S),#0);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInfoPane.Draw                    }
+{****************************************************************************}
+procedure TFileInfoPane.Draw;
+var
+  B: TDrawBuffer;
+  D: String[9];
+  M: String[3];
+  PM: Boolean;
+  Color: Word;
+  Time: DateTime;
+  Path: PathStr;
+  FmtId: String;
+  Params: array[0..7] of LongInt;
+  Str: String[80];
+const
+  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
+  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
+  InValidFiles : array[0..2] of string[12] = ('','.','..');
+var
+  Month: array[1..12] of String[3];
+begin
+  Month[1] := Strings^.Get(smJan);
+  Month[2] := Strings^.Get(smFeb);
+  Month[3] := Strings^.Get(smMar);
+  Month[4] := Strings^.Get(smApr);
+  Month[5] := Strings^.Get(smMay);
+  Month[6] := Strings^.Get(smJun);
+  Month[7] := Strings^.Get(smJul);
+  Month[8] := Strings^.Get(smAug);
+  Month[9] := Strings^.Get(smSep);
+  Month[10] := Strings^.Get(smOct);
+  Month[11] := Strings^.Get(smNov);
+  Month[12] := Strings^.Get(smDec);
+  { Display path }
+  if (PFileDialog(Owner)^.Directory <> nil) then
+    Path := PFileDialog(Owner)^.Directory^
+  else Path := '';
+  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
+  Color := GetColor($01);
+  MoveChar(B, ' ', Color, Size.X * Size.Y); { fill with empty spaces }
+  WriteLine(0, 0, Size.X, Size.Y, B);
+  MoveStr(B[1], Path, Color);
+  WriteLine(0, 0, Size.X, 1, B);
+  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
+     (S.Name = InValidFiles[2]) then
+    Exit;
+
+  { Display file }
+  Params[0] := LongInt(@S.Name);
+  if S.Attr and Directory <> 0 then
+  begin
+    FmtId := sDirectoryLine;
+    D := Strings^.Get(sDirectory);
+    Params[1] := LongInt(@D);
+  end else
+  begin
+    FmtId := sFileLine;
+    Params[1] := S.Size;
+  end;
+  UnpackTime(S.Time, Time);
+  M := Month[Time.Month];
+  Params[2] := LongInt(@M);
+  Params[3] := Time.Day;
+  Params[4] := Time.Year;
+  PM := Time.Hour >= 12;
+  Time.Hour := Time.Hour mod 12;
+  if Time.Hour = 0 then Time.Hour := 12;
+  Params[5] := Time.Hour;
+  Params[6] := Time.Min;
+  if PM then
+    Params[7] := Byte('p')
+  else Params[7] := Byte('a');
+  FormatStr(Str, FmtId, Params);
+  MoveStr(B, Str, Color);
+  WriteLine(0, 1, Size.X, 1, B);
+
+  { Fill in rest of rectangle }
+  MoveChar(B, ' ', Color, Size.X);
+  WriteLine(0, 2, Size.X, Size.Y-2, B);
+end;
+
+function TFileInfoPane.GetPalette: PPalette;
+const
+  P: String[Length(CInfoPane)] = CInfoPane;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
+  begin
+    S := PSearchRec(Event.InfoPtr)^;
+    DrawView;
+  end;
+end;
+
+{****************************************************************************
+              TFileHistory
+****************************************************************************}
+
+  function LTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := 1;
+    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
+    LTrim := Copy(S, I, 255);
+  end;
+
+  function RTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := Length(S);
+    while S[I] = ' ' do Dec(I);
+    RTrim := Copy(S, 1, I);
+  end;
+
+  function RelativePath(var S: PathStr): Boolean;
+  begin
+    S := LTrim(RTrim(S));
+    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
+  end;
+
+{ try to reduce the length of S+dir as a file path+pattern }
+
+  function Simplify (var S,Dir : string) : string;
+    var i : sw_integer;
+  begin
+   if RelativePath(Dir) then
+     begin
+        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
+          begin
+             i:=Length(S);
+             for i:=Length(S)-1 downto 1 do
+               if S[i]=DirSeparator then
+                 break;
+             if S[i]=DirSeparator then
+               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
+             else
+               Simplify:=S+Dir;
+          end
+        else
+          Simplify:=S+Dir;
+     end
+   else
+      Simplify:=Dir;
+  end;
+
+{****************************************************************************}
+{ TFileHistory.HandleEvent                                                       }
+{****************************************************************************}
+procedure TFileHistory.HandleEvent(var Event: TEvent);
+var
+  HistoryWindow: PHistoryWindow;
+  R,P: TRect;
+  C: Word;
+  Rslt: String;
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evMouseDown) or
+     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
+      (Link^.State and sfFocused <> 0)) then
+  begin
+    if not Link^.Focus then
+    begin
+      ClearEvent(Event);
+      Exit;
+    end;
+    if assigned(CurDir) then
+     Rslt:=CurDir^
+    else
+     Rslt:='';
+    Rslt:=Simplify(Rslt,Link^.Data^);
+    If IsWild(Rslt) then
+      RecordHistory(Rslt);
+    Link^.GetBounds(R);
+    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
+    Owner^.GetExtent(P);
+    R.Intersect(P);
+    Dec(R.B.Y,1);
+    HistoryWindow := InitHistoryWindow(R);
+    if HistoryWindow <> nil then
+    begin
+      C := Owner^.ExecView(HistoryWindow);
+      if C = cmOk then
+      begin
+        Rslt := HistoryWindow^.GetSelection;
+        if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
+        Link^.Data^ := Rslt;
+        Link^.SelectAll(True);
+        Link^.DrawView;
+      end;
+      Dispose(HistoryWindow, Done);
+    end;
+    ClearEvent(Event);
+  end
+  else if (Event.What = evBroadcast) then
+    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
+      or (Event.Command = cmRecordHistory) then
+    begin
+      if assigned(CurDir) then
+       Rslt:=CurDir^
+      else
+       Rslt:='';
+      Rslt:=Simplify(Rslt,Link^.Data^);
+      If IsWild(Rslt) then
+        RecordHistory(Rslt);
+    end;
+end;
+
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
+  var S,S2 : String;
+      i,Count : Sw_word;
+begin
+   if assigned(CurDir) then
+     begin
+        S:=CurDir^;
+        if S=Dir then
+          exit;
+        DisposeStr(CurDir);
+     end
+   else
+     S:='';
+   CurDir:=NewStr(Simplify(S,Dir));
+
+   Count:=HistoryCount(HistoryId);
+   for i:=1 to count do
+     begin
+        S2:=HistoryStr(HistoryId,1);
+        HistoryRemove(HistoryId,1);
+        if RelativePath(S2) then
+          if S<>'' then
+            S2:=S+S2
+          else
+            S2:=FExpand(S2);
+        { simply full path
+          we should simplify relative to Dir ! }
+        HistoryAdd(HistoryId,S2);
+     end;
+
+end;
+
+destructor TFileHistory.Done;
+begin
+  If assigned(CurDir) then
+    DisposeStr(CurDir);
+  Inherited Done;
+end;
+
+{****************************************************************************
+              TFileDialog
+****************************************************************************}
+
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
+  InputName: String; AOptions: Word; HistoryId: Byte);
+var
+  Control: PView;
+  R: TRect;
+  Opt: Word;
+begin
+  R.Assign(15,1,64,20);
+  TDialog.Init(R, ATitle);
+  Options := Options or ofCentered;
+  WildCard := AWildCard;
+
+  R.Assign(3,3,31,4);
+  FileName := New(PFileInputLine, Init(R, 79));
+  FileName^.Data^ := WildCard;
+  Insert(FileName);
+  R.Assign(2,2,3+CStrLen(InputName),3);
+  Control := New(PLabel, Init(R, InputName, FileName));
+  Insert(Control);
+  R.Assign(31,3,34,4);
+  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
+  Insert(FileHistory);
+
+  R.Assign(3,14,34,15);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3,6,34,14);
+  FileList := New(PFileList, Init(R, PScrollBar(Control)));
+  Insert(FileList);
+  R.Assign(2,5,8,6);
+  Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
+  Insert(Control);
+
+  R.Assign(35,3,46,5);
+  Opt := bfDefault;
+  if AOptions and fdOpenButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdOkButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdReplaceButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdClearButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  if AOptions and fdHelpButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+
+  R.Assign(1,16,48,18);
+  Control := New(PFileInfoPane, Init(R));
+  Insert(Control);
+
+  SelectNext(False);
+
+  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
+end;
+
+constructor TFileDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(WildCard, SizeOf(TWildStr));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S, FileName);
+  GetSubViewPtr(S, FileList);
+  GetSubViewPtr(S, FileHistory);
+  ReadDirectory;
+  if (DosError <> 0) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+destructor TFileDialog.Done;
+begin
+  DisposeStr(Directory);
+  TDialog.Done;
+end;
+
+procedure TFileDialog.GetData(var Rec);
+begin
+  GetFilename(PathStr(Rec));
+end;
+
+procedure TFileDialog.GetFileName(var S: PathStr);
+
+var
+  Path: PathStr;
+  Name: NameStr;
+  Ext: ExtStr;
+  TWild : string;
+  TPath: PathStr;
+  TName: NameStr;
+  TExt: NameStr;
+  i : Sw_integer;
+begin
+  S := FileName^.Data^;
+  if RelativePath(S) then
+    begin
+      if (Directory <> nil) then
+   S := FExpand(Directory^ + S);
+    end
+  else
+    S := FExpand(S);
+  if Pos(ListSeparator,S)=0 then
+   begin
+     If FileExists(S) then
+       exit;
+     FSplit(S, Path, Name, Ext);
+     if ((Name = '') or (Ext = '')) and not IsDir(S) then
+     begin
+       TWild:=WildCard;
+       repeat
+    i:=Pos(ListSeparator,TWild);
+    if i=0 then
+     i:=length(TWild)+1;
+    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
+    if ((Name = '') and (Ext = '')) then
+      S := Path + TName + TExt
+    else
+      if Name = '' then
+        S := Path + TName + Ext
+      else
+        if Ext = '' then
+          begin
+       if IsWild(Name) then
+         S := Path + Name + TExt
+       else
+         S := Path + Name + NoWildChars(TExt);
+          end;
+    if FileExists(S) then
+     break;
+    System.Delete(TWild,1,i);
+       until TWild='';
+       if TWild='' then
+         S := Path + Name + Ext;
+     end;
+   end;
+end;
+
+procedure TFileDialog.HandleEvent(var Event: TEvent);
+begin
+  if (Event.What and evBroadcast <> 0) and
+     (Event.Command = cmListItemSelected) then
+  begin
+    EndModal(cmFileOpen);
+    ClearEvent(Event);
+  end;
+  TDialog.HandleEvent(Event);
+  if Event.What = evCommand then
+    case Event.Command of
+      cmFileOpen, cmFileReplace, cmFileClear:
+   begin
+     EndModal(Event.Command);
+     ClearEvent(Event);
+   end;
+    end;
+end;
+
+procedure TFileDialog.SetData(var Rec);
+begin
+  TDialog.SetData(Rec);
+  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
+  begin
+    Valid(cmFileInit);
+    FileName^.Select;
+  end;
+end;
+
+procedure TFileDialog.ReadDirectory;
+begin
+  FileList^.ReadDirectory(WildCard);
+  FileHistory^.AdaptHistoryToDir(GetCurDir);
+  Directory := NewStr(GetCurDir);
+end;
+
+procedure TFileDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  S.Write(WildCard, SizeOf(TWildStr));
+  PutSubViewPtr(S, FileName);
+  PutSubViewPtr(S, FileList);
+  PutSubViewPtr(S, FileHistory);
+end;
+
+function TFileDialog.Valid(Command: Word): Boolean;
+var
+  FName: PathStr;
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+
+  function CheckDirectory(var S: PathStr): Boolean;
+  begin
+    if not PathValid(S) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
+      FileName^.Select;
+      CheckDirectory := False;
+    end else CheckDirectory := True;
+  end;
+
+  function CompleteDir(const Path: string): string;
+  begin
+    { keep c: untouched PM }
+    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
+       (Path[Length(Path)]<>':') then
+     CompleteDir:=Path+DirSeparator
+    else
+     CompleteDir:=Path;
+  end;
+
+  function NormalizeDir(const Path: string): string;
+  var Root: boolean;
+  begin
+    Root:=false;
+    {$ifdef Linux}
+    if Path=DirSeparator then Root:=true;
+    {$else}
+    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
+       (Path[2]=':') and (Path[3]=DirSeparator) then
+         Root:=true;
+    {$endif}
+    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
+      NormalizeDir:=copy(Path,1,length(Path)-1)
+    else
+      NormalizeDir:=Path;
+  end;
+function NormalizeDirF(var S: openstring): boolean;
+begin
+  S:=NormalizeDir(S);
+  NormalizeDirF:=true;
+end;
+
+begin
+  if Command = 0 then
+  begin
+    Valid := True;
+    Exit;
+  end
+  else Valid := False;
+  if TDialog.Valid(Command) then
+  begin
+    GetFileName(FName);
+    if (Command <> cmCancel) and (Command <> cmFileClear) then
+    begin
+      if IsWild(FName) or IsList(FName) then
+      begin
+        FSplit(FName, Dir, Name, Ext);
+        if CheckDirectory(Dir) then
+        begin
+          FileHistory^.AdaptHistoryToDir(Dir);
+          DisposeStr(Directory);
+          Directory := NewStr(Dir);
+          if Pos(ListSeparator,FName)>0 then
+           WildCard:=Copy(FName,length(Dir)+1,255)
+          else
+           WildCard := Name+Ext;
+          if Command <> cmFileInit then
+            FileList^.Select;
+          FileList^.ReadDirectory(Directory^+WildCard);
+        end;
+      end
+    else
+      if NormalizeDirF(FName) then
+      { ^^ this is just a dummy if construct (the func always returns true,
+        it's just there, 'coz I don't want to rearrange the following "if"s... }
+      if IsDir(FName) then
+        begin
+          if CheckDirectory(FName) then
+          begin
+            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
+            DisposeStr(Directory);
+            Directory := NewSTr(CompleteDir(FName));
+            if Command <> cmFileInit then FileList^.Select;
+            FileList^.ReadDirectory(Directory^+WildCard);
+          end
+        end
+      else
+        if ValidFileName(FName) then
+          Valid := True
+        else
+          begin
+            MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
+            Valid := False;
+          end;
+    end
+    else Valid := True;
+  end;
+end;
+
+{ TDirCollection }
+
+function TDirCollection.GetItem(var S: TStream): Pointer;
+var
+  DirItem: PDirEntry;
+begin
+  New(DirItem);
+  DirItem^.DisplayText := S.ReadStr;
+  DirItem^.Directory := S.ReadStr;
+  GetItem := DirItem;
+end;
+
+procedure TDirCollection.FreeItem(Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  DisposeStr(DirItem^.DisplayText);
+  DisposeStr(DirItem^.Directory);
+  Dispose(DirItem);
+end;
+
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  S.WriteStr(DirItem^.DisplayText);
+  S.WriteStr(DirItem^.Directory);
+end;
+
+{ TDirListBox }
+
+const
+  DrivesS: String = '';
+  Drives: PString = @DrivesS;
+
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
+  PScrollBar);
+begin
+  DrivesS := strings^.get(sDrives);
+  TListBox.Init(Bounds, 1, AScrollBar);
+  Dir := '';
+end;
+
+destructor TDirListBox.Done;
+begin
+  if (List <> nil) then
+    Dispose(List,Done);
+  TListBox.Done;
+end;
+
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
+begin
+  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
+end;
+
+procedure TDirListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown:
+      if Event.Double then
+      begin
+   Event.What := evCommand;
+   Event.Command := cmChangeDir;
+   PutEvent(Event);
+   ClearEvent(Event);
+      end;
+    evKeyboard:
+      if (Event.CharCode = ' ') and
+    (PSearchRec(List^.At(Focused))^.Name = '..') then
+   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
+  end;
+  TListBox.HandleEvent(Event);
+end;
+
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
+begin
+  IsSelected := Item = Cur;
+end;
+
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
+const
+  PathDir       = 'ÀÄÂ';
+  FirstDir     =   'ÀÂÄ';
+  MiddleDir   =   ' ÃÄ';
+  LastDir       =   ' ÀÄ';
+  IndentSize    = '  ';
+var
+  AList: PCollection;
+  NewDir, Dirct: DirStr;
+  C, OldC: Char;
+  S, Indent: String[80];
+  P: PString;
+  isFirst: Boolean;
+  SR: SearchRec;
+  I: Sw_Integer;
+
+  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
+  var
+    DirEntry: PDirEntry;
+  begin
+    New(DirEntry);
+    DirEntry^.DisplayText := NewStr(DisplayText);
+    DirEntry^.Directory := NewStr(Directory);
+    NewDirEntry := DirEntry;
+  end;
+
+begin
+  Dir := ADir;
+  AList := New(PDirCollection, Init(5,5));
+{$ifdef HAS_DOS_DRIVES}
+  AList^.Insert(NewDirEntry(Drives^,Drives^));
+  if Dir = Drives^ then
+  begin
+    isFirst := True;
+    OldC := ' ';
+    for C := 'A' to 'Z' do
+    begin
+      if (C < 'C') or DriveValid(C) then
+      begin
+   if OldC <> ' ' then
+   begin
+     if isFirst then
+     begin
+       S := FirstDir + OldC;
+       isFirst := False;
+     end
+     else S := MiddleDir + OldC;
+     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
+   end;
+   if C = GetCurDrive then Cur := AList^.Count;
+   OldC := C;
+      end;
+    end;
+    if OldC <> ' ' then
+      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
+  end
+  else
+{$endif HAS_DOS_DRIVES}
+  begin
+    Indent := IndentSize;
+    NewDir := Dir;
+{$ifdef HAS_DOS_DRIVES}
+    Dirct := Copy(NewDir,1,3);
+    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
+    NewDir := Copy(NewDir,4,255);
+{$else HAS_DOS_DRIVES}
+    Dirct := '';
+{$endif HAS_DOS_DRIVES}
+    while NewDir <> '' do
+    begin
+      I := Pos(DirSeparator,NewDir);
+      if I <> 0 then
+      begin
+   S := Copy(NewDir,1,I-1);
+   Dirct := Dirct + S;
+   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
+   NewDir := Copy(NewDir,I+1,255);
+      end
+      else
+      begin
+   Dirct := Dirct + NewDir;
+   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
+   NewDir := '';
+      end;
+      Indent := Indent + IndentSize;
+      Dirct := Dirct + DirSeparator;
+    end;
+    Cur := AList^.Count-1;
+    isFirst := True;
+    NewDir := Dirct + '*.*';
+    FindFirst(NewDir, Directory, SR);
+    while DosError = 0 do
+    begin
+      if (SR.Attr and Directory <> 0) and
+{$ifdef FPC}
+         (SR.Name <> '.') and (SR.Name <> '..') then
+{$else : not FPC}
+         (SR.Name[1] <> '.') then
+{$endif not FPC}
+      begin
+   if isFirst then
+   begin
+     S := FirstDir;
+     isFirst := False;
+   end else S := MiddleDir;
+   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
+      end;
+      FindNext(SR);
+    end;
+ {$ifdef fpc}
+  FindClose(SR);
+ {$endif}
+    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
+    I := Pos('À',P^);
+    if I = 0 then
+    begin
+      I := Pos('Ã',P^);
+      if I <> 0 then P^[I] := 'À';
+    end else
+    begin
+      P^[I+1] := 'Ä';
+      P^[I+2] := 'Ä';
+    end;
+  end;
+  NewList(AList);
+  FocusItem(Cur);
+end;
+
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
+begin
+  TListBox.SetState(AState, Enable);
+  if AState and sfFocused <> 0 then
+    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
+end;
+
+{****************************************************************************}
+{ TChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TChDirDialog.Init                      }
+{****************************************************************************}
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
+var
+  R: TRect;
+  Control: PView;
+begin
+  R.Assign(16, 2, 64, 20);
+  TDialog.Init(R,strings^.get(sChangeDirectory));
+
+  Options := Options or ofCentered;
+
+  R.Assign(3, 3, 30, 4);
+  DirInput := New(PInputLine, Init(R, 68));
+  Insert(DirInput);
+  R.Assign(2, 2, 17, 3);
+  Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
+  Insert(Control);
+  R.Assign(30, 3, 33, 4);
+  Control := New(PHistory, Init(R, DirInput, HistoryId));
+  Insert(Control);
+
+  R.Assign(32, 6, 33, 16);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3, 6, 32, 16);
+  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
+  Insert(DirList);
+  R.Assign(2, 5, 17, 6);
+  Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
+  Insert(Control);
+
+  R.Assign(35, 6, 45, 8);
+  OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
+  Insert(OkButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
+           bfNormal));
+  Insert(ChDirButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
+  if AOptions and cdHelpButton <> 0 then
+  begin
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+    Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
+  end;
+
+  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
+
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Load                      }
+{****************************************************************************}
+constructor TChDirDialog.Load(var S: TStream);
+begin
+  TDialog.Load(S);
+  GetSubViewPtr(S, DirList);
+  GetSubViewPtr(S, DirInput);
+  GetSubViewPtr(S, OkButton);
+  GetSubViewPtr(S, ChDirbutton);
+  SetUpDialog;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.DataSize                      }
+{****************************************************************************}
+function TChDirDialog.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.GetData                        }
+{****************************************************************************}
+procedure TChDirDialog.GetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.HandleEvent                   }
+{****************************************************************************}
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
+var
+  CurDir: DirStr;
+  P: PDirEntry;
+begin
+  TDialog.HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+   case Event.Command of
+     cmRevert: GetDir(0,CurDir);
+     cmChangeDir:
+       begin
+         P := DirList^.List^.At(DirList^.Focused);
+         if (P^.Directory^ = Drives^)
+            or DriveValid(P^.Directory^[1]) then
+           CurDir := P^.Directory^
+         else Exit;
+       end;
+   else
+     Exit;
+   end;
+   if (Length(CurDir) > 3) and
+      (CurDir[Length(CurDir)] = DirSeparator) then
+     CurDir := Copy(CurDir,1,Length(CurDir)-1);
+   DirList^.NewDirectory(CurDir);
+   DirInput^.Data^ := CurDir;
+   DirInput^.DrawView;
+   DirList^.Select;
+   ClearEvent(Event);
+      end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetData                        }
+{****************************************************************************}
+procedure TChDirDialog.SetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetUpDialog                   }
+{****************************************************************************}
+procedure TChDirDialog.SetUpDialog;
+var
+  CurDir: DirStr;
+begin
+  if DirList <> nil then
+  begin
+    CurDir := GetCurDir;
+    DirList^.NewDirectory(CurDir);
+    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+      CurDir := Copy(CurDir,1,Length(CurDir)-1);
+    if DirInput <> nil then
+    begin
+      DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Store                    }
+{****************************************************************************}
+procedure TChDirDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S, DirList);
+  PutSubViewPtr(S, DirInput);
+  PutSubViewPtr(S, OkButton);
+  PutSubViewPtr(S, ChDirButton);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Valid                    }
+{****************************************************************************}
+function TChDirDialog.Valid(Command: Word): Boolean;
+var
+  P: PathStr;
+begin
+  Valid := True;
+  if Command = cmOk then
+  begin
+    P := FExpand(DirInput^.Data^);
+    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
+      Dec(P[0]);
+    {$I-}
+    ChDir(P);
+    if (IOResult <> 0) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
+      Valid := False;
+    end;
+    {$I+}
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TEditChDirDialog.DataSize                    }
+{****************************************************************************}
+function TEditChDirDialog.DataSize : Sw_Word;
+begin
+  DataSize := SizeOf(DirStr);
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.GetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.GetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if (DirInput = nil) then
+    CurDir := ''
+  else begin
+    CurDir := DirInput^.Data^;
+    if (CurDir[Length(CurDir)] <> DirSeparator) then
+      CurDir := CurDir + DirSeparator;
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.SetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.SetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if DirList <> nil then
+  begin
+    DirList^.NewDirectory(CurDir);
+    if DirInput <> nil then
+    begin
+      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
+      else DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TSortedListBox Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TSortedListBox.Init                     }
+{****************************************************************************}
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
+  AScrollBar: PScrollBar);
+begin
+  TListBox.Init(Bounds, ANumCols, AScrollBar);
+  SearchPos := 0;
+  ShowCursor;
+  SetCursor(1,0);
+end;
+
+{****************************************************************************}
+{ TSortedListBox.HandleEvent                  }
+{****************************************************************************}
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
+const
+  SpecialChars: set of Char = [#0,#9,#27];
+var
+  CurString, NewString: String;
+  K: Pointer;
+  Value : Sw_integer;
+  OldPos, OldValue: Sw_Integer;
+  T: Boolean;
+begin
+  OldValue := Focused;
+  TListBox.HandleEvent(Event);
+  if (OldValue <> Focused) or
+     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
+      (Event.Command = cmReleasedFocus)) then
+    SearchPos := 0;
+  if Event.What = evKeyDown then
+  begin
+    { patched to prevent error when no or empty list or Escape pressed }
+    if (not (Event.CharCode in SpecialChars)) and
+       (List <> nil) and (List^.Count > 0) then
+    begin
+      Value := Focused;
+      if Value < Range then CurString := GetText(Value, 255)
+      else CurString := '';
+      OldPos := SearchPos;
+      if Event.KeyCode = kbBack then
+      begin
+   if SearchPos = 0 then Exit;
+   Dec(SearchPos);
+   if SearchPos = 0 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+      end
+      else if (Event.CharCode = '.') then SearchPos := Pos('.',CurString)
+      else
+      begin
+   Inc(SearchPos);
+   if SearchPos = 1 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+   CurString[SearchPos] := Event.CharCode;
+      end;
+      K := GetKey(CurString);
+      T := PSortedCollection(List)^.Search(K, Value);
+      if Value < Range then
+      begin
+   if Value < Range then NewString := GetText(Value, 255)
+   else NewString := '';
+   if Equal(NewString, CurString, SearchPos) then
+   begin
+     if Value <> OldValue then
+     begin
+       FocusItem(Value);
+       { Assumes ListControl will set the cursor to the first character }
+       { of the sfFocused item }
+       SetCursor(Cursor.X+SearchPos, Cursor.Y);
+     end
+     else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
+   end
+   else SearchPos := OldPos;
+      end
+      else SearchPos := OldPos;
+      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
+   ClearEvent(Event);
+    end
+  end;
+end;
+
+function TSortedListBox.GetKey(var S: String): Pointer;
+begin
+  GetKey := @S;
+end;
+
+procedure TSortedListBox.NewList(AList: PCollection);
+begin
+  TListBox.NewList(AList);
+  SearchPos := 0;
+end;
+
+{****************************************************************************}
+{            Global Procedures and Functions          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Contains                          }
+{****************************************************************************}
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+var
+  i : Byte;
+begin
+  Contains := True;
+  i := 1;
+  while ((i < Length(S2)) and (i < Length(S1))) do
+    if (Upcase(S1[i]) = Upcase(S2[i])) then
+      Exit
+    else Inc(i);
+  Contains := False;
+end;
+
+{****************************************************************************}
+{ StdDeleteFile                           }
+{****************************************************************************}
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnDelete then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
+               @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdDeleteFile := False;
+end;
+
+{****************************************************************************}
+{ DriveValid                         }
+{****************************************************************************}
+function DriveValid(Drive: Char): Boolean;
+{$ifdef HAS_DOS_DRIVES}
+var
+  D: Char;
+begin
+  D := GetCurDrive;
+  {$I-}
+  ChDir(Drive+':');
+  if (IOResult = 0) then
+  begin
+    DriveValid := True;
+    ChDir(D+':')
+  end
+  else DriveValid := False;
+  {$I+}
+end;
+{$else HAS_DOS_DRIVES}
+begin
+  DriveValid:=true;
+end;
+{$endif HAS_DOS_DRIVES}
+
+{****************************************************************************}
+{ Equal                             }
+{****************************************************************************}
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+var
+  i: Sw_Word;
+begin
+  Equal := False;
+  if (Length(S1) < Count) or (Length(S2) < Count) then
+    Exit;
+  for i := 1 to Count do
+    if UpCase(S1[I]) <> UpCase(S2[I]) then
+      Exit;
+  Equal := True;
+end;
+
+{****************************************************************************}
+{ ExtractDir                         }
+{****************************************************************************}
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  if D = '' then
+  begin
+    ExtractDir := '';
+    Exit;
+  end;
+  if D[Byte(D[0])] <> DirSeparator then
+    D := D + DirSeparator;
+  ExtractDir := D;
+end;
+
+{****************************************************************************}
+{ ExtractFileName                       }
+{****************************************************************************}
+function ExtractFileName(AFile: FNameStr): NameStr;
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  ExtractFileName := N;
+end;
+
+{****************************************************************************}
+{ FileExists                         }
+{****************************************************************************}
+function FileExists (AFile : FNameStr) : Boolean;
+begin
+  FileExists := (FSearch(AFile,'') <> '');
+end;
+
+{****************************************************************************}
+{ GetCurDir                        }
+{****************************************************************************}
+function GetCurDir: DirStr;
+var
+  CurDir: DirStr;
+begin
+  GetDir(0, CurDir);
+  if (Length(CurDir) > 3) then
+  begin
+    Inc(CurDir[0]);
+    CurDir[Length(CurDir)] := DirSeparator;
+  end;
+  GetCurDir := CurDir;
+end;
+
+{****************************************************************************}
+{ GetCurDrive                       }
+{****************************************************************************}
+function GetCurDrive: Char;
+{$ifdef go32v2}
+var
+  Regs : Registers;
+begin
+  Regs.AH := $19;
+  Intr($21,Regs);
+  GetCurDrive := Char(Regs.AL + Byte('A'));
+end;
+{$else not go32v2}
+var
+  D : DirStr;
+begin
+  D:=GetCurDir;
+  if (Length(D)>1) and (D[2]=':') then
+    begin
+      if (D[1]>='a') and (D[1]<='z') then
+        GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
+      else
+        GetCurDrive:=D[1];
+    end
+  else
+    GetCurDrive:='C';
+end;
+{$endif not go32v2}
+
+{****************************************************************************}
+{ IsDir                             }
+{****************************************************************************}
+function IsDir(const S: String): Boolean;
+var
+  SR: SearchRec;
+  Is: boolean;
+begin
+  Is:=false;
+{$ifdef Linux}
+  Is:=(S=DirSeparator); { handle root }
+{$else}
+  Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
+  { handle root dirs }
+{$endif}
+  if Is=false then
+  begin
+    FindFirst(S, Directory, SR);
+    if DosError = 0 then
+      Is := (SR.Attr and Directory) <> 0
+    else
+      Is := False;
+   {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+  IsDir:=Is;
+end;
+
+{****************************************************************************}
+{ IsWild                           }
+{****************************************************************************}
+function IsWild(const S: String): Boolean;
+begin
+  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
+end;
+
+{****************************************************************************}
+{ IsList                           }
+{****************************************************************************}
+function IsList(const S: String): Boolean;
+begin
+  IsList := (Pos(ListSeparator,S) > 0);
+end;
+
+{****************************************************************************}
+{ MakeResources                           }
+{****************************************************************************}
+procedure MakeResources;
+var
+  Dlg : PDialog;
+  Key : String;
+  i : Word;
+begin
+  for i := 0 to 1 do
+  begin
+    case i of
+      0 : begin
+       Key := reOpenDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      1 : begin
+       Key := reSaveAsDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      2 : begin
+       Key := reEditChDirDialog;
+       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
+             hiCurrentDirectories));
+     end;
+    end;
+    if Dlg = nil then
+    begin
+       PrintStr('Error initializing dialog ' + Key);
+       Halt;
+    end
+    else begin
+      RezFile^.Put(Dlg,Key);
+      if (RezFile^.Stream^.Status <> stOk) then
+      begin
+   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
+   Halt;
+      end;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ NoWildChars                       }
+{****************************************************************************}
+function NoWildChars(S: String): String;
+const
+  WildChars : array[0..1] of Char = ('?','*');
+var
+  i : Sw_Word;
+begin
+  repeat
+    i := Pos('?',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  repeat
+    i := Pos('*',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  NoWildChars:=S;
+end;
+
+{****************************************************************************}
+{ OpenFile                          }
+{****************************************************************************}
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
+end;
+
+{****************************************************************************}
+{ OpenNewFile                       }
+{****************************************************************************}
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+begin
+  OpenNewFile := False;
+  if OpenFile(AFile,HistoryID) then
+  begin
+    if not ValidFileName(AFile) then
+      Exit;
+    if FileExists(AFile) then
+      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
+   Exit;
+    OpenNewFile := True;
+  end;
+end;
+
+{****************************************************************************}
+{ PathValid                        }
+{****************************************************************************}
+{$ifdef go32v2}
+{$define NetDrive}
+{$endif go32v2}
+{$ifdef win32}
+{$define NetDrive}
+{$endif win32}
+function PathValid (var Path: PathStr): Boolean;
+var
+  ExpPath: PathStr;
+  SR: SearchRec;
+begin
+  ExpPath := FExpand(Path);
+{$ifdef HAS_DOS_DRIVES}
+  if (Length(ExpPath) <= 3) then
+    PathValid := DriveValid(ExpPath[1])
+  else
+{$endif}
+  begin
+    { do not change '/' into '' }
+    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
+      Dec(ExpPath[0]);
+    FindFirst(ExpPath, Directory, SR);
+    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
+{$ifdef NetDrive}
+    if DosError=66 then
+      begin
+      {$ifdef fpc}
+        FindClose(SR);
+      {$endif}
+        FindFirst(ExpPath+'\*',AnyFile,SR);
+        PathValid:=(DosError = 0);
+      end;
+{$endif NetDrive}
+    {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ RegisterStdDlg                         }
+{****************************************************************************}
+procedure RegisterStdDlg;
+begin
+  RegisterType(RFileInputLine);
+  RegisterType(RFileCollection);
+  RegisterType(RFileList);
+  RegisterType(RFileInfoPane);
+  RegisterType(RFileDialog);
+  RegisterType(RDirCollection);
+  RegisterType(RDirListBox);
+  RegisterType(RSortedListBox);
+  RegisterType(RChDirDialog);
+end;
+
+{****************************************************************************}
+{ StdReplaceFile                         }
+{****************************************************************************}
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnReplace then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdReplaceFile :=
+       (MessageBox(^C + Strings^.Get(sReplaceFile),
+         @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdReplaceFile := True;
+end;
+
+{****************************************************************************}
+{ SaveAs                           }
+{****************************************************************************}
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  SaveAs := False;
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+        labels^.get(slSaveAs),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  Dlg^.HelpCtx := hcSaveAs;
+  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
+     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
+    SaveAs := True;
+end;
+
+{****************************************************************************}
+{ SelectDir                        }
+{****************************************************************************}
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+var
+  Dir: DirStr;
+  Dlg : PEditChDirDialog;
+  Rec : DirStr;
+begin
+  {$I-}
+  GetDir(0,Dir);
+  {$I+}
+  Rec := FExpand(ADir);
+  {$ifdef cdResource}
+  Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
+  {$else}
+  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
+  {$endif cdResource}
+  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
+  begin
+    SelectDir := True;
+    ADir := Rec;
+  end
+  else SelectDir := False;
+  {$I-}
+  ChDir(Dir);
+  {$I+}
+end;
+
+{****************************************************************************}
+{ ShrinkPath                         }
+{****************************************************************************}
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+var
+  Filler: string;
+  D1 : DirStr;
+  N1 : NameStr;
+  E1 : ExtStr;
+  i  : Sw_Word;
+
+begin
+  if Length(AFile) > MaxLen then
+  begin
+    FSplit(FExpand(AFile),D1,N1,E1);
+    AFile := Copy(D1,1,3) + '..' + DirSeparator;
+    i := Pred(Length(D1));
+    while (i > 0) and (D1[i] <> DirSeparator) do
+      Dec(i);
+    if (i = 0) then
+      AFile := AFile + D1
+    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
+    if AFile[Length(AFile)] <> DirSeparator then
+      AFile := AFile + DirSeparator;
+    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
+      AFile := AFile + N1 + E1
+    else
+      begin
+        Filler := '...' + DirSeparator;
+        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
+                +Filler+N1+E1;
+      end;
+  end;
+  ShrinkPath := AFile;
+end;
+
+{****************************************************************************}
+{ ValidFileName                           }
+{****************************************************************************}
+function ValidFileName(var FileName: PathStr): Boolean;
+var
+  IllegalChars: string[12];
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+begin
+{$ifdef PPC_FPC}
+{$ifdef go32v2}
+  { spaces are allowed if LFN is supported }
+  if LFNSupport then
+    IllegalChars := ';,=+<>|"[]'+DirSeparator
+  else
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$else not go32v2}
+{$ifdef win32}
+    IllegalChars := ';,=+<>|"[]'+DirSeparator;
+{$else not go32v2 and not win32 }
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif not win32}
+{$endif not go32v2}
+{$else not PPC_FPC}
+  IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif PPC_FPC}
+  ValidFileName := True;
+  FSplit(FileName, Dir, Name, Ext);
+  if not ((Dir = '') or PathValid(Dir)) or
+     Contains(Name, IllegalChars) or
+     Contains(Dir, IllegalChars) then
+    ValidFileName := False;
+end;
+
+{****************************************************************************}
+{        Unit Initialization Section                                         }
+{****************************************************************************}
+begin
+{$ifdef PPC_BP}
+  ReplaceFile := StdReplaceFile;
+  DeleteFile := StdDeleteFile;
+{$else}
+  ReplaceFile := @StdReplaceFile;
+  DeleteFile := @StdDeleteFile;
+{$endif PPC_BP}
+end.

+ 530 - 0
fv/tabs.pas

@@ -0,0 +1,530 @@
+unit tabs;
+interface
+
+uses
+  objects,drivers,views;
+
+type
+    PTabItem = ^TTabItem;
+    TTabItem = record
+      Next : PTabItem;
+      View : PView;
+      Dis  : boolean;
+    end;
+
+    PTabDef = ^TTabDef;
+    TTabDef = record
+      Next     : PTabDef;
+      Name     : PString;
+      Items    : PTabItem;
+      DefItem  : PView;
+      ShortCut : char;
+    end;
+
+    PTab = ^TTab;
+    TTab = object(TGroup)
+      TabDefs   : PTabDef;
+      ActiveDef : integer;
+      DefCount  : word;
+      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+      function    AtTab(Index: integer): PTabDef; virtual;
+      procedure   SelectTab(Index: integer); virtual;
+      function    TabCount: integer;
+      function    Valid(Command: Word): Boolean; virtual;
+      procedure   ChangeBounds(var Bounds: TRect); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   Draw; virtual;
+      procedure   SetData(var Rec);virtual;
+      procedure   GetData(var Rec);virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      destructor  Done; virtual;
+    private
+      InDraw: boolean;
+    end;
+
+function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+
+implementation
+
+uses
+  FvCommon,dialogs;
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+  inherited Init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+  TabDefs:=ATabDef;
+  ActiveDef:=-1;
+  SelectTab(0);
+  ReDraw;
+end;
+
+function TTab.TabCount: integer;
+var i: integer;
+    P: PTabDef;
+begin
+  I:=0; P:=TabDefs;
+  while (P<>nil) do
+    begin
+      Inc(I);
+      P:=P^.Next;
+    end;
+  TabCount:=I;
+end;
+
+
+function TTab.AtTab(Index: integer): PTabDef;
+var i: integer;
+    P: PTabDef;
+begin
+  i:=0; P:=TabDefs;
+  while (I<Index) do
+    begin
+      if P=nil then RunError($AA);
+      P:=P^.Next;
+      Inc(i);
+    end;
+  AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: integer);
+var P: PTabItem;
+    V: PView;
+begin
+  if ActiveDef<>Index then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Lock;
+    { --- Update --- }
+    if TabDefs<>nil then
+       begin
+         DefCount:=1;
+         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+       end
+       else DefCount:=0;
+    if ActiveDef<>-1 then
+    begin
+      P:=AtTab(ActiveDef)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then Delete(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+    ActiveDef:=Index;
+    P:=AtTab(ActiveDef)^.Items;
+    while P<>nil do
+      begin
+        if P^.View<>nil then Insert(P^.View);
+        P:=P^.Next;
+      end;
+    V:=AtTab(ActiveDef)^.DefItem;
+    if V<>nil then V^.Select;
+    ReDraw;
+    { --- Update --- }
+    UnLock;
+    if Owner<>nil then Owner^.UnLock;
+    DrawView;
+  end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+  R: TRect;
+begin
+  if P^.Owner=nil then Exit; { it think this is a bug in TV }
+  P^.CalcBounds(R, D);
+  P^.ChangeBounds(R);
+end;
+var
+    P: PTabItem;
+    I: integer;
+begin
+  D.X := Bounds.B.X - Bounds.A.X - Size.X;
+  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+  inherited ChangeBounds(Bounds);
+  for I:=0 to TabCount-1 do
+  if I<>ActiveDef then
+    begin
+      P:=AtTab(I)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then DoCalcChange(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : integer;
+    I     : integer;
+    X     : integer;
+    Len   : byte;
+    P     : TPoint;
+    V     : PView;
+    CallOrig: boolean;
+    LastV : PView;
+    FirstV: PView;
+function FirstSelectable: PView;
+var
+    FV : PView;
+begin
+  FV := First;
+  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+        FV:=FV^.Next;
+  if FV<>nil then
+    if (FV^.Options and ofSelectable)=0 then FV:=nil;
+  FirstSelectable:=FV;
+end;
+function LastSelectable: PView;
+var
+    LV : PView;
+begin
+  LV := Last;
+  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+        LV:=LV^.Prev;
+  if LV<>nil then
+    if (LV^.Options and ofSelectable)=0 then LV:=nil;
+  LastSelectable:=LV;
+end;
+begin
+  if (Event.What and evMouseDown)<>0 then
+     begin
+       MakeLocal(Event.Where,P);
+       if P.Y<3 then
+          begin
+            Index:=-1; X:=1;
+            for i:=0 to DefCount-1 do
+                begin
+                  Len:=CStrLen(AtTab(i)^.Name^);
+                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+                  X:=X+Len+3;
+                end;
+            if Index<>-1 then
+               SelectTab(Index);
+          end;
+     end;
+  if Event.What=evKeyDown then
+     begin
+       Index:=-1;
+       case Event.KeyCode of
+            kbTab,kbShiftTab  :
+              if GetState(sfSelected) then
+                 begin
+                   if Current<>nil then
+                   begin
+                   LastV:=LastSelectable; FirstV:=FirstSelectable;
+                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+                      begin
+                        if Owner<>nil then Owner^.SelectNext(true);
+                      end else
+                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+                      begin
+                        Lock;
+                        if Owner<>nil then Owner^.SelectNext(false);
+                        UnLock;
+                      end else
+                   SelectNext(Event.KeyCode=kbShiftTab);
+                   ClearEvent(Event);
+                   end;
+                 end;
+       else
+       for I:=0 to DefCount-1 do
+           begin
+             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
+                then begin
+                       Index:=I;
+                       ClearEvent(Event);
+                       Break;
+                     end;
+           end;
+       end;
+       if Index<>-1 then
+          begin
+            Select;
+            SelectTab(Index);
+            V:=AtTab(ActiveDef)^.DefItem;
+            if V<>nil then V^.Focus;
+          end;
+     end;
+  CallOrig:=true;
+  if Event.What=evKeyDown then
+     begin
+     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+        then
+        else CallOrig:=false;
+     end;
+  if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+procedure TTab.Draw;
+var B     : TDrawBuffer;
+    i     : integer;
+    C1,C2,C3,C : word;
+    HeaderLen  : integer;
+    X,X2       : integer;
+    Name       : PString;
+    ActiveKPos : integer;
+    ActiveVPos : integer;
+    FC   : char;
+procedure SWriteBuf(X,Y,W,H: integer; var Buf);
+var i: integer;
+begin
+  if Y+H>Size.Y then H:=Size.Y-Y;
+  if X+W>Size.X then W:=Size.X-X;
+  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+                else for i:=1 to H do
+                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+  MoveChar(B,' ',C1,Size.X);
+end;
+begin
+  if InDraw then Exit;
+  InDraw:=true;
+  { - Start of TGroup.Draw - }
+{  if Buffer = nil then
+  begin
+    GetBuffer;
+  end; }
+  { - Start of TGroup.Draw - }
+
+  C1:=GetColor(1);
+  C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256;
+  C3:=GetColor(8)+GetColor({9}8)*256;
+
+  { Calculate the size of the headers }
+  HeaderLen:=0;
+  for i:=0 to DefCount-1 do
+    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3;
+  Dec(HeaderLen);
+  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+  { --- 1. sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        if i=ActiveDef
+           then begin
+                  ActiveKPos:=X-1;
+                  ActiveVPos:=X+X2+2;
+                  if GetState(sfFocused) then C:=C3 else C:=C2;
+                end
+           else C:=C2;
+        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
+        MoveChar(B[X-1],'³',C1,1);
+      end;
+  SWriteBuf(0,1,Size.X,1,B);
+
+  { --- 0. sor --- }
+  ClearBuf; MoveChar(B[0],'Ú',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        if I<ActiveDef then FC:='Ú'
+                       else FC:='¿';
+        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        MoveChar(B[X+X2],{'Â'}FC,C1,1);
+        if i=DefCount-1 then X2:=X2+1;
+        if X2>0 then
+        MoveChar(B[X],'Ä',C1,X2);
+        X:=X+X2+1;
+      end;
+  MoveChar(B[HeaderLen+1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
+  SWriteBuf(0,0,Size.X,1,B);
+
+  { --- 2. sor --- }
+  MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
+  MoveChar(B[Size.X-1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ù',C1,1);
+  if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
+                 else MoveChar(B[0],{'Ã'}'Ú',C1,1);
+  MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
+  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+  SWriteBuf(0,2,Size.X,1,B);
+
+  { --- marad‚k sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
+  SWriteBuf(0,3,Size.X,Size.Y-4,B);
+
+  { --- Size.X . sor --- }
+  MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
+  SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+  { - End of TGroup.Draw - }
+  if Buffer <> nil then
+  begin
+    Lock;
+    Redraw;
+    UnLock;
+  end;
+  if Buffer <> nil then
+    WriteBuf(0, 0, Size.X, Size.Y, Buffer^)
+  else
+    Redraw;
+  { - End of TGroup.Draw - }
+  InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+    PI : PTabItem;
+    OK : boolean;
+begin
+  OK:=true;
+  PT:=TabDefs;
+  while (PT<>nil) and (OK=true) do
+        begin
+          PI:=PT^.Items;
+          while (PI<>nil) and (OK=true) do
+                begin
+                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+                  PI:=PI^.Next;
+                end;
+          PT:=PT^.Next;
+        end;
+  Valid:=OK;
+end;
+
+
+procedure TTab.SetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.SetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.GetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.GetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and sfFocused)<>0 then DrawView;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if P<>nil then Delete(P);
+end;
+begin
+  ForEach(@DeleteViews);
+  inherited Done;
+  P:=TabDefs;
+  while P<>nil do
+        begin
+          X:=P^.Next;
+          DisposeTabDef(P);
+          P:=X;
+        end;
+end;
+
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Next:=ANext; P^.View:=AView;
+  NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+  if P<>nil then
+  begin
+    if P^.View<>nil then Dispose(P^.View, Done);
+    Dispose(P);
+  end;
+end;
+
+function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+    x: byte;
+begin
+  New(P);
+  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  x:=pos('~',AName);
+  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+                                  else P^.ShortCut:=#0;
+  P^.DefItem:=ADefItem;
+  NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+  DisposeStr(P^.Name);
+  PI:=P^.Items;
+  while PI<>nil do
+    begin
+      X:=PI^.Next;
+      DisposeTabItem(PI);
+      PI:=X;
+    end;
+  Dispose(P);
+end;
+
+end.

+ 955 - 0
fv/test/Makefile

@@ -0,0 +1,955 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override TARGET_PROGRAMS+=tfileio testapp
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FV
+PACKAGEDIR_FV:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fv/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_FV),)
+PACKAGEDIR_FV:=$(firstword $(PACKAGEDIR_FV))
+ifeq ($(wildcard $(PACKAGEDIR_FV)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_fv
+package_fv:
+	$(MAKE) -C $(PACKAGEDIR_FV) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FV)/$(OS_TARGET)),)
+UNITDIR_FV=$(PACKAGEDIR_FV)/$(OS_TARGET)
+else
+UNITDIR_FV=$(PACKAGEDIR_FV)
+endif
+else
+PACKAGEDIR_FV=
+UNITDIR_FV:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fv/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FV),)
+UNITDIR_FV:=$(firstword $(UNITDIR_FV))
+else
+UNITDIR_FV=
+endif
+endif
+ifdef UNITDIR_FV
+override COMPILER_UNITDIR+=$(UNITDIR_FV)
+endif
+endif
+.PHONY: package_rtl package_fv
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_exes
+ifdef TARGET_PROGRAMS
+override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+endif
+fpc_exes: $(EXEFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif

+ 12 - 0
fv/test/Makefile.fpc

@@ -0,0 +1,12 @@
+#
+#   Makefile.fpc for Free Vision Test/Examples
+#
+
+[target]
+programs=tfileio testapp
+
+[require]
+packages=fv
+
+[default]
+fpcdir=../..

+ 390 - 0
fv/test/platform.inc

@@ -0,0 +1,390 @@
+{ $Id$ }
+{***************[ PLATFORM INCLUDE UNIT ]******************}
+{                                                          }
+{    System independent INCLUDE file to sort PLATFORMS     }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                     }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{        LINUX    - FPC 0.9912+             (32 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     02 Jul 97  Bazsi  Initial implementation        }
+{  0.2     28 Aug 97  LdB    Fixed OS2 platform sort       }
+{  0.3     29 Aug 97  LdB    Added assembler type changes  }
+{  0.4     29 Aug 97  LdB    OS_DOS removed from WINDOWS   }
+{  0.5     23 Oct 97  LdB    Delphi & speed compilers      }
+{  0.6     05 May 98  LdB    Virtual Pascal 2.0 added      }
+{  0.7     19 May 98  LdB    Delphi 2/3 definitions added  }
+{  0.8     06 Aug 98  CEC    FPC only support fixed WIN32  }
+{  0.9     10 Aug 98  LdB    BP_VMTLink def/Undef added    }
+{  1.0     27 Aug 98  LdB    Atari, Mac etc not undef dos  }
+{  1.1     25 Oct 98  PfV    Delphi 4 definitions added    }
+{  1.2     06 Jun 99  LdB    Sybil 2.0 support added       }
+{  1.3     13 Jun 99  LdB    Sybil 2.0 undef BP_VMT link   }
+{  1.31    03 Nov 99  LdB    FPC windows defines WIN32     }
+{  1.32    04 Nov 99  LdB    Delphi 5 definitions added    }
+{  1.33    16 Oct 00  LdB    WIN32/WIN16 defines added     }
+{**********************************************************}
+
+{ ****************************************************************************
+
+   This include file defines some conditional defines to allow us to select
+   the compiler/platform/target in a consequent way.
+
+    OS_XXXX         The operating system used (XXXX may be one of:
+                       DOS, OS2, Linux, Windows, Go32)
+    PPC_XXXX        The compiler used: BP, FPK, Virtual, Speed
+    BIT_XX          The number of bits of the target platform: 16 or 32
+    PROC_XXXX       The mode of the target processor (Real or Protected)
+                    This shouldn't be used, except for i386 specific parts.
+    ASM_XXXX        This is the assembler type: BP, ISO-ANSI, FPK
+
+ ****************************************************************************
+
+    This is how the IFDEF and UNDEF statements below should translate.
+
+
+ PLATFORM  SYSTEM    COMPILER  COMP ID      CPU MODE        BITS    ASSEMBLER
+ --------  ------    --------  -------      --------        ----    ---------
+
+ DOS      OS_DOS      BP/TP7   PPC_BP       PROC_Real       BIT_16  ASM_BP
+
+ DPMI     OS_DOS      BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ WINDOWS  OS_WINDOWS  BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      DELPHI   PPC_DELPHI   PROC_Protected  BIT_16  ASM_BP
+                      DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_16  ASM_BP
+
+ WIN95/NT OS_WINDOWS  DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI3  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI4  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI5  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT 32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ OS2      OS_OS2      BPOS2    PPC_BPOS2    PROC_Protected  BIT_16  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT_32  ASM_BP
+                      SPEED    PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ ****************************************************************************}
+{****************************************************************************
+
+FOR ALL COMPILERS BP_VMTLink defined but FPC and Delphi3/Delphi4 undefine it
+
+ ****************************************************************************}
+{****************************************************************************
+
+FOR FPC THESE ARE THE TRANSLATIONS
+
+  PLATFORM  SYSTEM    COMPILER  HANDLE SIZE      ASM          CPU
+ --------  ------    --------  -----------      ----         ---
+
+ DOS      OS_DOS,OS_GO32 FPC     32-bit         AT&T         CPU86
+
+ WIN32    OS_WINDOWS   FPC     32-bit           AT&T         ----
+
+ LINUX    OS_LINUX     FPC     32-bit           AT&T         ----
+
+ OS2      OS_OS2       FPC     ?????            AT&T         CPU86
+
+ ATARI    OS_ATARI     FPC     32-bit           Internal     CPU68
+
+ MACOS    OS_MAC       FPC     ?????            Internal     CPU68
+
+ AMIGA    OS_AMIGA     FPC     32-bit           Internal     CPU68
+
+ ****************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  Initial assume BORLAND 16 BIT DOS COMPILER - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$DEFINE OS_DOS}
+{$DEFINE PROC_Real}
+{$DEFINE BIT_16}
+{$DEFINE PPC_BP}
+{$DEFINE ASM_BP}
+{$DEFINE BP_VMTLink}
+{$DEFINE CPU86}
+
+{---------------------------------------------------------------------------}
+{  BORLAND 16 BIT DPMI changes protected mode - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$IFDEF DPMI}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF FPC}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_FPC}
+  {$UNDEF ASM_BP}
+  {$DEFINE ASM_FPC}
+  {$UNDEF BP_VMTLink}
+  {$DEFINE Use_API}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{$IFDEF NoAPI}
+{$UNDEF Use_API}
+{$UNDEF NO_WINDOW}
+{$ENDIF UseAPI}
+
+
+{---------------------------------------------------------------------------}
+{  FPC LINUX COMPILER changes operating system - Updated 27Aug98 LdB        }
+{  Note: Other linux compilers would need to change other details           }
+{---------------------------------------------------------------------------}
+{$IFDEF LINUX}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_LINUX}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC GO32V2 COMPILER changes operating system - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF GO32V2}
+  {$DEFINE OS_GO32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
+{---------------------------------------------------------------------------}
+{$IFDEF WIN32}
+  {$IFNDEF WINDOWS}
+    {$DEFINE WINDOWS}
+  {$ENDIF}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WINDOWS COMPILERS change op system and proc mode - Updated 03Nov99 LdB   }
+{---------------------------------------------------------------------------}
+{$IFDEF WINDOWS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_WINDOWS}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$IFDEF FPC}
+    {$DEFINE WIN32}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI1 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER80}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI2 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER90}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI2}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI3 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER100}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI4 COMPILER changes compiler type - Updated 25Oct98 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER120}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI5 COMPILER changes compiler type - Updated 04Nov99 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER130}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$DEFINE PPC_DELPHI5}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  OS2 COMPILERS change compiler type and mode - Updated 27Aug98 LdB        }
+{  Note: Assumes BPOS2 16BIT OS2 patch except for FPC which undefines this  }
+{---------------------------------------------------------------------------}
+{$IFDEF OS2}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_OS2}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_BPOS2}
+  {$IFDEF FPC}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  VIRTUAL PASCAL changes compiler type/32 bit - Updated 27Aug98 LdB        }
+{  Note: VP2 can compile win 32 code so changes op system as needed         }
+{---------------------------------------------------------------------------}
+{$IFDEF VirtualPascal}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$IFDEF PPC_BPOS2}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+  {$DEFINE PPC_VIRTUAL}
+  {$IFDEF WIN32}
+    {$UNDEF PPC_BP}
+    {$UNDEF OS_OS2}
+    {$DEFINE OS_WINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  SPEED COMPILER changes compiler type/32 bit  - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF Speed}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BPOS2}
+  {$DEFINE PPC_SPEED}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC AMIGA COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF AMIGA}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_AMIGA}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC ATARI COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF ATARI}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_ATARI}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC MAC COMPILER changes op system and CPU type - Updated 27Aug98 LdB    }
+{---------------------------------------------------------------------------}
+{$IFDEF MACOS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_MAC}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF OS_DOS}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB                }
+{---------------------------------------------------------------------------}
+{$IFDEF OS_WINDOWS}                                   { WINDOWS SYSTEM }
+  {$IFDEF BIT_16}
+    {$DEFINE WIN16}                                   { 16 BIT WINDOWS }
+  {$ENDIF}
+  {$IFDEF BIT_32}
+    {$DEFINE WIN32}                                   { 32 BIT WINDOWS }
+  {$ENDIF}
+{$ENDIF}
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.5  2001/05/03 22:32:52  pierre
+  new bunch of changes, displays something for dos at least
+
+ Revision 1.4  2001/04/10 21:57:56  pierre
+  + first adds for Use_API define
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}
+

+ 6 - 2
fvision/testapp.pas → fv/test/testapp.pas

@@ -122,8 +122,8 @@ begin
      end
      end
    else
    else
       WasSet:=false;
       WasSet:=false;
-{$endif DEBUG}
    if WriteDebugInfo then
    if WriteDebugInfo then
+{$endif DEBUG}
   Clock^.Update;
   Clock^.Update;
   Heap^.Update;
   Heap^.Update;
 {$ifdef DEBUG}
 {$ifdef DEBUG}
@@ -353,7 +353,11 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.6  2001-05-31 21:40:10  pierre
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.6  2001/05/31 21:40:10  pierre
   * some debug stuff changed
   * some debug stuff changed
 
 
  Revision 1.5  2001/05/04 15:43:46  pierre
  Revision 1.5  2001/05/04 15:43:46  pierre

+ 2 - 2
fv/test/tfileio.pas

@@ -1,10 +1,10 @@
 USES
 USES
-  Common,FileIO;
+  FVCommon,FileIO;
 
 
 VAR
 VAR
   Handle : THandle;
   Handle : THandle;
   buf    : ARRAY[0..255] OF CHAR;
   buf    : ARRAY[0..255] OF CHAR;
-  n 	 : Longint;
+  n      : Longint;
 BEGIN
 BEGIN
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   writeln('FileOpen: ',Handle);
   writeln('FileOpen: ',Handle);

+ 6 - 2
fv/validate.pas

@@ -74,7 +74,7 @@ UNIT Validate;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Objects;                                 { GFV standard units }
+USES FVCommon, Objects;                                 { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
 {                              PUBLIC CONSTANTS                             }
@@ -1058,7 +1058,11 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.4  2001-05-03 22:32:52  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 22:32:52  pierre
   new bunch of changes, displays something for dos at least
   new bunch of changes, displays something for dos at least
 
 
  Revision 1.3  2001/04/10 21:29:55  pierre
  Revision 1.3  2001/04/10 21:29:55  pierre

File diff suppressed because it is too large
+ 164 - 174
fv/views.pas


+ 1057 - 0
fvision/Makefile

@@ -0,0 +1,1057 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override PACKAGE_NAME=fv
+override PACKAGE_VERSION=1.0.5
+override TARGET_UNITS+=buildfv
+override TARGET_EXAMPLEDIRS+=test
+override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_FPCPACKAGE=y
+override COMPILER_TARGETDIR+=.
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+.PHONY: package_rtl
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifdef TARGET_UNITS
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+endif
+fpc_units: $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_examples
+ifdef TARGET_EXAMPLES
+HASEXAMPLES=1
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
+override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
+override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
+override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+endif
+ifdef TARGET_EXAMPLEDIRS
+HASEXAMPLES=1
+endif
+fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(ZIPPREFIX)$(PACKAGE_NAME)$(ZIPSUFFIX)
+endif
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(BATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=src
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=exm
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+TARGET_EXAMPLEDIRS_TEST=1
+ifdef TARGET_EXAMPLEDIRS_TEST
+test_all:
+	$(MAKE) -C test all
+test_debug:
+	$(MAKE) -C test debug
+test_smart:
+	$(MAKE) -C test smart
+test_examples:
+	$(MAKE) -C test examples
+test_shared:
+	$(MAKE) -C test shared
+test_install:
+	$(MAKE) -C test install
+test_sourceinstall:
+	$(MAKE) -C test sourceinstall
+test_exampleinstall:
+	$(MAKE) -C test exampleinstall
+test_distinstall:
+	$(MAKE) -C test distinstall
+test_zipinstall:
+	$(MAKE) -C test zipinstall
+test_zipsourceinstall:
+	$(MAKE) -C test zipsourceinstall
+test_zipexampleinstall:
+	$(MAKE) -C test zipexampleinstall
+test_zipdistinstall:
+	$(MAKE) -C test zipdistinstall
+test_clean:
+	$(MAKE) -C test clean
+test_distclean:
+	$(MAKE) -C test distclean
+test_cleanall:
+	$(MAKE) -C test cleanall
+test_info:
+	$(MAKE) -C test info
+test:
+	$(MAKE) -C test all
+.PHONY: test_all test_debug test_smart test_examples test_shared test_install test_sourceinstall test_exampleinstall test_distinstall test_zipinstall test_zipsourceinstall test_zipexampleinstall test_zipdistinstall test_clean test_distclean test_cleanall test_info test
+endif
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples: fpc_examples
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean $(addsuffix _clean,$(TARGET_EXAMPLEDIRS))
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 31 - 0
fvision/Makefile.fpc

@@ -0,0 +1,31 @@
+#
+#   Makefile.fpc for Free Vision for Free Pascal
+#
+
+[package]
+name=fv
+version=1.0.5
+
+[target]
+units=buildfv
+exampledirs=test
+
+[libs]
+libname=libfpfv.so
+libversion=1.0
+
+[compiler]
+targetdir=.
+
+[install]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+fpcpackage=y
+
+[clean]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+
+[default]
+fpcdir=..
+
+[rules]
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 6 - 2
fvision/app.pas

@@ -57,7 +57,7 @@ USES
    {$ENDIF}
    {$ENDIF}
 
 
    GFVGraph,                                          { GFV standard unit }
    GFVGraph,                                          { GFV standard unit }
-   Common, Memory,                                    { GFV standard units }
+   FVCommon, Memory,                                    { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
@@ -1088,7 +1088,11 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.11  2001-05-31 21:39:11  pierre
+ Revision 1.12  2001-08-04 19:14:32  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.11  2001/05/31 21:39:11  pierre
   + AltF12 to force Redraw of Application
   + AltF12 to force Redraw of Application
 
 
  Revision 1.10  2001/05/31 12:15:24  pierre
  Revision 1.10  2001/05/31 12:15:24  pierre

+ 42 - 0
fvision/buildfv.pas

@@ -0,0 +1,42 @@
+{
+  $Id$
+
+  Unit to build all units of Free Vision
+}
+unit buildfv;
+interface
+uses
+  fvcommon,
+  objects,
+  drivers,
+  fileio,
+  memory,
+  gfvgraph,
+
+  fvconsts,
+  resource,
+  views,
+  validate,
+  msgbox,
+  dialogs,
+  menus,
+  app,
+  stddlg,
+
+  tabs,
+  statuses,
+  histlist,
+  inplong,
+  gadgets,
+  time;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:32  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

File diff suppressed because it is too large
+ 630 - 71
fvision/dialogs.pas


+ 73 - 69
fvision/drivers.pas

@@ -78,7 +78,7 @@ USES
 
 
    video,
    video,
    GFVGraph,                                          { GFV graphics unit }
    GFVGraph,                                          { GFV graphics unit }
-   Common, Objects;                                   { GFV standard units }
+   FVCommon, Objects;                                 { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
 {                              PUBLIC CONSTANTS                             }
@@ -231,28 +231,28 @@ CONST
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 TYPE
 TYPE
    TEvent = PACKED RECORD
    TEvent = PACKED RECORD
-      What: Word;                                     { Event type }
-      Case Word Of
+      What: Sw_Word;                                     { Event type }
+      Case Sw_Word Of
         evNothing: ();                                { ** NO EVENT ** }
         evNothing: ();                                { ** NO EVENT ** }
         evMouse: (
         evMouse: (
           Buttons: Byte;                              { Mouse buttons }
           Buttons: Byte;                              { Mouse buttons }
           Double: Boolean;                            { Double click state }
           Double: Boolean;                            { Double click state }
           Where: TPoint);                             { Mouse position }
           Where: TPoint);                             { Mouse position }
         evKeyDown: (                                  { ** KEY EVENT ** }
         evKeyDown: (                                  { ** KEY EVENT ** }
-          Case Integer Of
-            0: (KeyCode: Word);                       { Full key code }
+          Case Sw_Integer Of
+            0: (KeyCode: Sw_Word);                       { Full key code }
             1: (CharCode: Char;                       { Char code }
             1: (CharCode: Char;                       { Char code }
                 ScanCode: Byte;                       { Scan code }
                 ScanCode: Byte;                       { Scan code }
                 KeyShift: byte));                     { Shift states }
                 KeyShift: byte));                     { Shift states }
         evMessage: (                                  { ** MESSAGE EVENT ** }
         evMessage: (                                  { ** MESSAGE EVENT ** }
-          Command: Word;                              { Message command }
-          Id     : Word;                              { Message id }
+          Command: Sw_Word;                              { Message command }
+          Id     : Sw_Word;                              { Message id }
           Data   : Real;                              { Message data }
           Data   : Real;                              { Message data }
-          Case Word Of
+          Case Sw_Word Of
             0: (InfoPtr: Pointer);                    { Message pointer }
             0: (InfoPtr: Pointer);                    { Message pointer }
             1: (InfoLong: Longint);                   { Message longint }
             1: (InfoLong: Longint);                   { Message longint }
-            2: (InfoWord: Word);                      { Message word }
-            3: (InfoInt: Integer);                    { Message integer }
+            2: (InfoWord: Word);                      { Message Sw_Word }
+            3: (InfoInt: Integer);                    { Message Sw_Integer }
             4: (InfoByte: Byte);                      { Message byte }
             4: (InfoByte: Byte);                      { Message byte }
             5: (InfoChar: Char));                     { Message character }
             5: (InfoChar: Char));                     { Message character }
    END;
    END;
@@ -262,7 +262,7 @@ TYPE
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 TYPE
 TYPE
-   TSysErrorFunc = FUNCTION (ErrorCode: Integer; Drive: Byte): Integer;
+   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -283,13 +283,13 @@ the screen. For example, given the string '~B~roccoli' as its
 parameter, CStrLen returns 8.
 parameter, CStrLen returns 8.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
 
 
 {-MoveStr------------------------------------------------------------
 {-MoveStr------------------------------------------------------------
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
-Dest must be a TDrawBuffer (or an equivalent array of words). The
-characters in Str are moved into the low bytes of corresponding words
-in Dest. The high bytes of the words are set to Attr, or remain
+Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
+characters in Str are moved into the low bytes of corresponding Sw_Words
+in Dest. The high bytes of the Sw_Words are set to Attr, or remain
 unchanged if Attr is zero.
 unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
@@ -297,30 +297,30 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
 
 {-MoveCStr-----------------------------------------------------------
 {-MoveCStr-----------------------------------------------------------
 The characters in Str are moved into the low bytes of corresponding
 The characters in Str are moved into the low bytes of corresponding
-words in Dest. The high bytes of the words are set to Lo(Attr) or
+Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
 Hi(Attr). Tilde characters (~) in the string toggle between the two
 Hi(Attr). Tilde characters (~) in the string toggle between the two
-attribute bytes passed in the Attr word.
+attribute bytes passed in the Attr Sw_Word.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
 
 {-MoveBuf------------------------------------------------------------
 {-MoveBuf------------------------------------------------------------
 Count bytes are moved from Source into the low bytes of corresponding
 Count bytes are moved from Source into the low bytes of corresponding
-words in Dest. The high bytes of the words in Dest are set to Attr,
+Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
 or remain unchanged if Attr is zero.
 or remain unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
 
 {-MoveChar------------------------------------------------------------
 {-MoveChar------------------------------------------------------------
 Moves characters into a buffer for use with a view's WriteBuf or
 Moves characters into a buffer for use with a view's WriteBuf or
-WriteLine. Dest must be a TDrawBuffer (or an equivalent array of words).
-The low bytes of the first Count words of Dest are set to C, or
-remain unchanged if Ord(C) is zero. The high bytes of the words are
+WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
+The low bytes of the first Count Sw_Words of Dest are set to C, or
+remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
 set to Attr, or remain unchanged if Attr is zero.
 set to Attr, or remain unchanged if Attr is zero.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                        KEYBOARD SUPPORT ROUTINES                          }
 {                        KEYBOARD SUPPORT ROUTINES                          }
@@ -351,7 +351,7 @@ Returns the ascii character for the Ctrl+Key scancode that was given.
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
 
 {-CtrlToArrow--------------------------------------------------------
 {-CtrlToArrow--------------------------------------------------------
-Converts a WordStar-compatible control key code to the corresponding
+Converts a Sw_WordStar-compatible control key code to the corresponding
 cursor key code.
 cursor key code.
 25May96 LdB
 25May96 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
@@ -449,7 +449,7 @@ PROCEDURE ClearScreen;
 Does nothing provided for compatability purposes only.
 Does nothing provided for compatability purposes only.
 04Jan97 LdB
 04Jan97 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           ERROR CONTROL ROUTINES                          }
 {                           ERROR CONTROL ROUTINES                          }
@@ -473,7 +473,7 @@ PROCEDURE DoneSysError;
 Error handling is not yet implemented so this simply drops through.
 Error handling is not yet implemented so this simply drops through.
 20May98 LdB
 20May98 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           STRING FORMAT ROUTINES                          }
 {                           STRING FORMAT ROUTINES                          }
@@ -532,25 +532,25 @@ CONST
    SysErrActive : Boolean = False;                    { Compatability only }
    SysErrActive : Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    ButtonCount  : Byte = 0;                           { Mouse button count }
    ButtonCount  : Byte = 0;                           { Mouse button count }
-   DoubleDelay  : Word = 8;                           { Double click delay }
-   RepeatDelay  : Word = 8;                           { Auto mouse delay }
-   SysColorAttr : Word = $4E4F;                       { System colour attr }
-   SysMonoAttr  : Word = $7070;                       { System mono attr }
-   StartupMode  : Word = $FFFF;                       { Compatability only }
-   CursorLines  : Word = $FFFF;                       { Compatability only }
+   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
+   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
+   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
+   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
+   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
+   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
-   SysErrorFunc : TSysErrorFunc = SystemError;        { System error ptr }
+   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }
 
 
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 CONST
 CONST
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
-   DefLineNum     : Integer = 25;                     { Default line number }
-   DefFontHeight  : Integer = 0;                      { Default font height }
-   SysFontWidth   : Integer = 8;                      { System font width }
-   SysFontHeight  : Integer = 16;                     { System font height }
+   DefLineNum     : Sw_Integer = 25;                     { Default line number }
+   DefFontHeight  : Sw_Integer = 0;                      { Default font height }
+   SysFontWidth   : Sw_Integer = 8;                      { System font width }
+   SysFontHeight  : Sw_Integer = 16;                     { System font height }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
@@ -565,7 +565,7 @@ VAR
    ScreenWidth : Byte;                                { Screen text width }
    ScreenWidth : Byte;                                { Screen text width }
    ScreenHeight: Byte;                                { Screen text height }
    ScreenHeight: Byte;                                { Screen text height }
 {$ifdef GRAPH_API}
 {$ifdef GRAPH_API}
-   ScreenMode  : Word;                                { Screen mode }
+   ScreenMode  : Sw_Word;                                { Screen mode }
 {$else not GRAPH_API}
 {$else not GRAPH_API}
    ScreenMode  : TVideoMode;                         { Screen mode }
    ScreenMode  : TVideoMode;                         { Screen mode }
 {$endif GRAPH_API}
 {$endif GRAPH_API}
@@ -628,10 +628,10 @@ CONST AltCodes: Array [0..127] Of Byte = (
 {                           NEW CONTROL VARIABLES                           }
 {                           NEW CONTROL VARIABLES                           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 CONST
 CONST
-   HideCount : Integer = 0;                           { Cursor hide count }
-   QueueCount: Word = 0;                              { Queued message count }
-   QueueHead : Word = 0;                              { Queue head pointer }
-   QueueTail : Word = 0;                              { Queue tail pointer }
+   HideCount : Sw_Integer = 0;                           { Cursor hide count }
+   QueueCount: Sw_Word = 0;                              { Queued message count }
+   QueueHead : Sw_Word = 0;                              { Queue head pointer }
+   QueueTail : Sw_Word = 0;                              { Queue tail pointer }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
@@ -644,14 +644,14 @@ VAR
    LastDouble : Boolean;                              { Last double buttons }
    LastDouble : Boolean;                              { Last double buttons }
    LastButtons: Byte;                                 { Last button state }
    LastButtons: Byte;                                 { Last button state }
    DownButtons: Byte;                                 { Last down buttons }
    DownButtons: Byte;                                 { Last down buttons }
-   EventCount : Word;                                 { Events in queue }
-   AutoDelay  : Word;                                 { Delay time count }
-   DownTicks  : Word;                                 { Down key tick count }
-   AutoTicks  : Word;                                 { Held key tick count }
-   LastWhereX : Word;                                 { Last x position }
-   LastWhereY : Word;                                 { Last y position }
-   DownWhereX : Word;                                 { Last x position }
-   DownWhereY : Word;                                 { Last y position }
+   EventCount : Sw_Word;                                 { Events in queue }
+   AutoDelay  : Sw_Word;                                 { Delay time count }
+   DownTicks  : Sw_Word;                                 { Down key tick count }
+   AutoTicks  : Sw_Word;                                 { Held key tick count }
+   LastWhereX : Sw_Word;                                 { Last x position }
+   LastWhereY : Sw_Word;                                 { Last y position }
+   DownWhereX : Sw_Word;                                 { Last x position }
+   DownWhereY : Sw_Word;                                 { Last y position }
    LastWhere  : TPoint;                               { Last mouse position }
    LastWhere  : TPoint;                               { Last mouse position }
    DownWhere  : TPoint;                               { Last down position }
    DownWhere  : TPoint;                               { Last down position }
    EventQHead : Pointer;                              { Head of queue }
    EventQHead : Pointer;                              { Head of queue }
@@ -865,8 +865,8 @@ end;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
-VAR I, J: Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
+VAR I, J: Sw_Integer;
 BEGIN
 BEGIN
    J := 0;                                            { Set result to zero }
    J := 0;                                            { Set result to zero }
    For I := 1 To Length(S) Do
    For I := 1 To Length(S) Do
@@ -881,7 +881,7 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Length(Str) Do Begin                 { For each character }
    For I := 1 To Length(Str) Do Begin                 { For each character }
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
    End;
    End;
@@ -891,12 +891,12 @@ END;
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
-VAR B: Byte; I, J: Word; P: PWord;
+VAR B: Byte; I, J: Sw_Word; P: PWord;
 BEGIN
 BEGIN
    J := 0;                                            { Start position }
    J := 0;                                            { Start position }
    For I := 1 To Length(Str) Do Begin                 { For each character }
    For I := 1 To Length(Str) Do Begin                 { For each character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
-       P := @TWordArray(Dest)[J];                     { Pointer to word }
+       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
        If (Lo(Attrs) <> 0) Then
        If (Lo(Attrs) <> 0) Then
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
@@ -912,11 +912,11 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Count Do Begin
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
    End;
    End;
@@ -925,11 +925,11 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 VAR I: Word; P: PWord;
 BEGIN
 BEGIN
    For I := 1 To Count Do Begin
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
    End;
    End;
@@ -964,7 +964,7 @@ END;
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 FUNCTION GetAltChar (KeyCode: Word): Char;
 FUNCTION GetAltChar (KeyCode: Word): Char;
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    GetAltChar := #0;                                  { Preset fail return }
    GetAltChar := #0;                                  { Preset fail return }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
@@ -997,10 +997,10 @@ FUNCTION CtrlToArrow (KeyCode: Word): Word;
 CONST NumCodes = 11;
 CONST NumCodes = 11;
       CtrlCodes : Array [0..NumCodes-1] Of Char =
       CtrlCodes : Array [0..NumCodes-1] Of Char =
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
-      ArrowCodes: Array [0..NumCodes-1] Of Word =
+      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
         kbPgUp, kbPgDn, kbBack);
         kbPgUp, kbPgDn, kbBack);
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    CtrlToArrow := KeyCode;                            { Preset key return }
    CtrlToArrow := KeyCode;                            { Preset key return }
    For I := 0 To NumCodes - 1 Do
    For I := 0 To NumCodes - 1 Do
@@ -1029,7 +1029,7 @@ end;
 procedure GetKeyEvent (Var Event: TEvent);
 procedure GetKeyEvent (Var Event: TEvent);
 var
 var
   key      : TKeyEvent;
   key      : TKeyEvent;
-  keycode  : word;
+  keycode  : Word;
   keyshift : byte;
   keyshift : byte;
 begin
 begin
   if Keyboard.PollKeyEvent<>0 then
   if Keyboard.PollKeyEvent<>0 then
@@ -1205,11 +1205,11 @@ END;
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE InitVideo;
 PROCEDURE InitVideo;
-VAR {$ifdef Use_API}I, J: Integer;
+VAR {$ifdef Use_API}I, J: Sw_Integer;
     {$else not Use_API}
     {$else not Use_API}
-    {$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
+    {$IFDEF OS_DOS} I, J: Sw_Integer;Ts: TextSettingsType;{$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
-    {$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
+    {$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
     {$ENDIF}
     {$ENDIF}
 BEGIN
 BEGIN
 {$ifdef GRAPH_API}
 {$ifdef GRAPH_API}
@@ -1271,7 +1271,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 BEGIN
 BEGIN
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
      Else DefLineNum := 24;                           { Normal 24 line mode }
      Else DefLineNum := 24;                           { Normal 24 line mode }
@@ -1300,7 +1300,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 BEGIN
 BEGIN
    If (FailSysErrors = False) Then Begin              { Check error ignore }
    If (FailSysErrors = False) Then Begin              { Check error ignore }
 
 
@@ -1474,7 +1474,11 @@ BEGIN
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.10  2001-05-10 16:46:27  pierre
+ Revision 1.11  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.10  2001/05/10 16:46:27  pierre
   + some improovements made
   + some improovements made
 
 
  Revision 1.9  2001/05/07 22:22:03  pierre
  Revision 1.9  2001/05/07 22:22:03  pierre

+ 24 - 6
fvision/fileio.pas

@@ -93,7 +93,7 @@ UNIT FileIO;
 
 
 USES
 USES
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
-  Common;                                             { Standard GFV unit }
+  FVCommon;                                           { Standard GFV unit }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                             PUBLIC CONSTANTS                              }
 {                             PUBLIC CONSTANTS                              }
@@ -154,7 +154,7 @@ access mode the file is opened and the file handle returned. If the
 name or mode is invalid or an error occurs the return will be zero.
 name or mode is invalid or an error occurs the return will be zero.
 27Oct98 LdB
 27Oct98 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 
 
 {-SetFileSize--------------------------------------------------------
 {-SetFileSize--------------------------------------------------------
 The file opened by the handle is set the given size. If the action is
 The file opened by the handle is set the given size. If the action is
@@ -228,7 +228,21 @@ FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Wor
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
-  USES unix;
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
+{$ENDIF}
+
+{$IFDEF OS_FREEBSD}                                   { FREEBSD COMPILER }
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
 {$ENDIF}
 {$ENDIF}
 
 
 {***************************************************************************}
 {***************************************************************************}
@@ -292,7 +306,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    ASSEMBLER;
    ASSEMBLER;
@@ -679,7 +693,11 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.4  2001-05-03 15:55:44  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 15:55:44  pierre
   + linux support for fileio contributed by Holger Schurig
   + linux support for fileio contributed by Holger Schurig
 
 
  Revision 1.3  2001/04/10 21:29:55  pierre
  Revision 1.3  2001/04/10 21:29:55  pierre
@@ -689,4 +707,4 @@ END.
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 430 - 0
fvision/fvcommon.pas

@@ -0,0 +1,430 @@
+{ $Id$  }
+{********************[ COMMON UNIT ]***********************}
+{                                                          }
+{    System independent COMMON TYPES & DEFINITIONS         }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                      }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - Speed Pascal 1.0+       (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     12 Jul 97  Bazsi  Initial implementation        }
+{  0.2     18 Jul 97  Bazsi  Linux specific error codes    }
+{  0.2.2   28 Jul 97  Bazsi  Base error code for Video     }
+{  0.2.3   29 Jul 97  Bazsi  Basic types added (PByte etc) }
+{  0.2.5   08 Aug 97  Bazsi  Error handling code added     }
+{  0.2.6   06 Sep 97  Bazsi  Base code for keyboard        }
+{  0.2.7   06 Nov 97  Bazsi  Base error code for filectrl  }
+{  0.2.8   21 Jan 99  LdB    Max data sizes added.         }
+{  0.2.9   22 Jan 99  LdB    General array types added.    }
+{  0.3.0   27 Oct 99  LdB    Delphi3+ MaxAvail, MemAvail   }
+{  0.4.0   14 Nov 00  LdB    Revamp of whole unit          }
+{**********************************************************}
+
+UNIT FVCommon;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I Platform.inc}
+{====================================================================}
+
+{***************************************************************************}
+{                              PUBLIC CONSTANTS                             }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        SYSTEM ERROR BASE CONSTANTS                        }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  The following ranges have been defined for error codes:                  }
+{---------------------------------------------------------------------------}
+{        0 -  1000    OS dependant error codes                              }
+{     1000 - 10000    API reserved error codes                              }
+{    10000 -          Add-On unit error codes                               }
+{---------------------------------------------------------------------------}
+
+{---------------------------------------------------------------------------}
+{                         DEFINED BASE ERROR CONSTANTS                      }
+{---------------------------------------------------------------------------}
+CONST
+   errOk                = 0;                          { No error }
+   errVioBase           = 1000;                       { Video base offset }
+   errKbdBase           = 1010;                       { Keyboard base offset }
+   errFileCtrlBase      = 1020;                       { File IO base offset }
+   errMouseBase         = 1030;                       { Mouse base offset }
+
+{---------------------------------------------------------------------------}
+{                            MAXIUM DATA SIZES                              }
+{---------------------------------------------------------------------------}
+CONST
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITION }
+   MaxBytes = 65520;                                  { Maximum data size }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITION }
+   MaxBytes = 128*1024*1024;                          { Maximum data size }
+{$ENDIF}
+   MaxWords = MaxBytes DIV SizeOf(Word);              { Max words }
+   MaxInts  = MaxBytes DIV SizeOf(Integer);           { Max integers }
+   MaxLongs = MaxBytes DIV SizeOf(LongInt);           { Max longints }
+   MaxPtrs  = MaxBytes DIV SizeOf(Pointer);           { Max pointers }
+   MaxReals = MaxBytes DIV SizeOf(Real);              { Max reals }
+   MaxStr   = MaxBytes DIV SizeOf(String);            { Max strings }
+
+{***************************************************************************}
+{                          PUBLIC TYPE DEFINITIONS                          }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                           CPU TYPE DEFINITIONS                            }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_32}                                       { 32 BIT CODE }
+   CPUWord = Longint;                                 { CPUWord is 32 bit }
+   CPUInt = Longint;                                  { CPUInt is 32 bit }
+{$ELSE}                                               { 16 BIT CODE }
+   CPUWord = Word;                                    { CPUWord is 16 bit }
+   CPUInt = Integer;                                  { CPUInt is 16 bit }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                     16/32 BIT SWITCHED TYPE CONSTANTS                     }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITIONS }
+   Sw_Word    = Word;                                 { Standard word }
+   Sw_Integer = Integer;                              { Standard integer }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITIONS }
+   Sw_Word    = LongInt;                              { Long integer now }
+   Sw_Integer = LongInt;                              { Long integer now }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                           FILE HANDLE SIZE                                }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF OS_DOS}                                       { DOS DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_ATARI}                                     { ATARI DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_LINUX}                                     { LINUX DEFINITIONS }
+ { values are words, though the OS calls return 32-bit values }
+ { to check (CEC)                                             }
+  THandle = LongInt;                                  { Simulated 32 bits }
+{$ENDIF}
+{$IFDEF OS_AMIGA}                                     { AMIGA DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+{$IFDEF OS_WINDOWS}                                   { WIN/NT DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_OS2}                                       { OS2 DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_MAC}                                       { MACINTOSH DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                      POINTERS TO STANDARD DATA TYPES                      }
+{---------------------------------------------------------------------------}
+TYPE
+   PByte = ^Byte;                                     { Pointer to byte }
+   PWord = ^Word;                                     { Pointer to word }
+   PLongint = ^Longint;                               { Pointer to longint }
+
+{---------------------------------------------------------------------------}
+{                               GENERAL ARRAYS                              }
+{---------------------------------------------------------------------------}
+TYPE
+   TByteArray = ARRAY [0..MaxBytes-1] Of Byte;        { Byte array }
+   PByteArray = ^TByteArray;                          { Byte array pointer }
+
+   TWordArray = ARRAY [0..MaxWords-1] Of Word;        { Word array }
+   PWordArray = ^TWordArray;                          { Word array pointer }
+
+   TIntegerArray = ARRAY [0..MaxInts-1] Of Integer;   { Integer array }
+   PIntegerArray = ^TIntegerArray;                    { Integer array pointer }
+
+   TLongIntArray = ARRAY [0..MaxLongs-1] Of LongInt;  { LongInt array }
+   PLongIntArray = ^TLongIntArray;                    { LongInt array pointer }
+
+   TRealArray = Array [0..MaxReals-1] Of Real;        { Real array }
+   PRealarray = ^TRealArray;                          { Real array pointer }
+
+   TPointerArray = Array [0..MaxPtrs-1] Of Pointer;   { Pointer array }
+   PPointerArray = ^TPointerArray;                    { Pointer array ptr }
+
+   TStrArray = Array [0..MaxStr-1] Of String;         { String array }
+   PStrArray = ^TStrArray;                            { String array ptr }
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{-GetErrorCode-------------------------------------------------------
+Returns the last error code and resets ErrorCode to errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+
+{-GetErrorInfo-------------------------------------------------------
+Returns the info assigned to the previous error, doesn't reset the
+value to nil. Would usually only be called if ErrorCode <> errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+
+{-MinimumOf----------------------------------------------------------
+Given two real numbers returns the minimum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+
+{-MaximumOf----------------------------------------------------------
+Given two real numbers returns the maximum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+
+{-MinIntegerOf-------------------------------------------------------
+Given two integer values returns the lowest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+
+{-MaxIntegerof-------------------------------------------------------
+Given two integer values returns the biggest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+
+{-MinLongIntOf-------------------------------------------------------
+Given two long integers returns the minimum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+
+{-MaxLongIntOf-------------------------------------------------------
+Given two long integers returns the maximum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{ ******************************* REMARK ****************************** }
+{  Delphi 3+ does not define these standard routines so I have made     }
+{  some public functions here to complete compatability.                }
+{ ****************************** END REMARK *** Leon de Boer, 14Aug98 * }
+
+{-MemAvail-----------------------------------------------------------
+Returns the free memory available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+
+{-MaxAvail-----------------------------------------------------------
+Returns the max free memory block size available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+{$ENDIF}
+
+{***************************************************************************}
+{                        INITIALIZED PUBLIC VARIABLES                       }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
+{---------------------------------------------------------------------------}
+CONST
+   ErrorCode: Longint = errOk;                        { Last error code }
+   ErrorInfo: Pointer = Nil;                          { Last error info }
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                               IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ COMPILER }
+USES WinTypes, WinProcs;                              { Stardard units }
+{$ENDIF}
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  GetErrorCode -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+BEGIN
+   GetErrorCode := ErrorCode;                         { Return last error }
+   ErrorCode := 0;                                    { Now clear errorcode }
+END;
+
+{---------------------------------------------------------------------------}
+{  GetErrorInfo -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+BEGIN
+   GetErrorInfo := ErrorInfo;                         { Return errorinfo ptr }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I < J) Then Min := I Else Min := J;          { Select minimum }
+END;
+
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I > J) Then Max := I Else Max := J;          { Select maximum }
+END;
+
+
+{---------------------------------------------------------------------------}
+{  MinimumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+BEGIN
+   If (B < A) Then MinimumOf := B                     { B smaller take it }
+     Else MinimumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaximumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+BEGIN
+   If (B > A) Then MaximumOf := B                     { B bigger take it }
+     Else MaximumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B < A) Then MinIntegerOf := B                  { B smaller take it }
+     Else MinIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B > A) Then MaxIntegerOf := B                  { B bigger take it }
+     Else MaxIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B < A) Then MinLongIntOf := B                  { B smaller take it }
+     Else MinLongIntOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B > A) Then MaxLongIntOf := B                  { B bigger take it }
+     Else MaxLongIntOf := A;                          { Else take A }
+END;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MemAvail := Ms.dwAvailPhys;                        { Avail physical memory }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MaxAvail := Ms.dwTotalPhys;                        { Max physical memory }
+END;
+{$ENDIF}
+
+END.
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:20  marco
+  * CVS log and ID tags
+
+
+}

+ 631 - 0
fvision/fvconsts.pas

@@ -0,0 +1,631 @@
+{ $Id$  }
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of DIALOGS.PAS      }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
+{   [email protected]  - primary e-mail addr           }
+{   [email protected] - backup e-mail addr            }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{                                                          }
+{ Only Free Pascal Compiler supported                      }
+{                                                          }
+{**********************************************************}
+unit FVConsts;
+interface
+
+{
+  The ObjTypes unit declares constants for all object type IDs used in the
+  FreeVision library.  They have been moved here for easier management.  No
+  values for views declared in TV 2.0 have been changed from so that original
+  resource files may still be used.
+}
+const
+  { Views Unit }
+  idView = 1;
+  idFrame = 2;
+  idScrollBar = 3;
+  idScroller = 4;
+  idListViewer = 5;
+  idGroup = 6;
+  idWindow = 7;
+
+  { Dialogs Unit 10 - ? }
+  idDialog = 10;
+  idInputLine = 11;
+  idButton = 12;
+  idCluster = 13;
+  idRadioButtons = 14;
+  idCheckBoxes = 15;
+  idMultiCheckBoxes = 27;
+  idListBox = 16;
+  idStaticText = 17;
+  idLabel = 18;
+  idHistory = 19;
+  idParamText = 20;
+  idCommandCheckBoxes = 21;
+  idCommandRadioButtons = 22;
+  idCommandIcon = 23;
+  idBrowseButton = 24;
+  idEditListBox = 25;
+  idModalInputLine = 26;
+  idListDlg = 27;
+
+  { App Unit }
+  idBackground = 30;
+  idDesktop = 31;
+
+  { Config Unit }
+  idConfig = 32;
+  idMouseDlg = 33;
+  idVideoDlg = 34;
+  idClickTester = 35;
+
+  { Menus Unit }
+  idMenuBar = 40;
+  idMenuBox = 41;
+  idStatusLine = 42;
+  idMenuPopup = 43;
+  idMenuButton = 44;
+
+  { Objects Unit }
+  idCollection = 50;
+  idStringCollection = 51;
+  idStringList = 52;
+  idStrListMaker = 52;
+  idStrCollection = 69;
+
+  { Resource Unit }
+  idMemStringList = 52;
+
+  { StdDlg Unit }
+  idFileInputLine = 60;
+  idFileCollection = 61;
+  idFileList = 62;
+  idFileInfoPane = 63;
+  idFileDialog = 64;
+  idDirCollection = 65;
+  idDirListBox = 66;
+  idChDirDialog = 67;
+  idSortedListBox = 68;
+  idEditChDirDialog = 69;
+
+  { Editors Unit   70 - ? }
+  idEditor = 70;
+  idMemo = 71;
+  idFileEditor = 72;
+  idIndicator = 73;
+  idEditWindow = 74;
+  idEditWindowCollection = 75; { this value may need to be changed }
+  idEditorEngine = 76;
+
+  { Validate Unit }
+  idPXPictureValidator = 80;
+  idFilterValidator = 81;
+  idRangeValidator = 82;
+  idStringLookupValidator = 83;
+  idRealValidator = 84;
+  idByteValidator = 85;
+  idIntegerValidator = 86;
+  idSingleValidator = 87;
+  idWordValidator = 88;
+  idDateValidator = 89;
+  idTimeValidator = 90;
+
+  { Outline Unit }
+  idOutline = 91;
+
+  { ColorSel Unit }
+  idColorSelector = 92;
+  idMonoSelector = 93;
+  idColorDisplay = 94;
+  idColorGroupList = 95;
+  idColorItemList = 96;
+  idColorDialog = 97;
+
+  { Statuses Unit }
+  idStatus   = 300;
+  idStatusDlg = 301;
+  idStatusMessageDlg = 302;
+  idGauge = 303;
+  idArrowGauge = 304;
+  idBarGauge = 305;
+  idPercentGauge = 306;
+  idSpinnerGauge = 307;
+  idAppStatus = 308;
+  idHeapMinAvail = 309;
+  idHeapMemAvail = 310;
+
+  { FVList Unit }
+
+
+{
+ The Commands unit contains all command constants used in the FreeVision
+ library.  They have been extracted from their original units and placed here
+ for easier maintainence and modification to remove conflicts, such as Borland
+ created with the cmChangeDir constant in the StdDlg and App units.
+}
+
+const
+  { App Unit }
+  cmNew           = 30;
+  cmOpen          = 31;
+  cmSave          = 32;
+  cmSaveAs        = 33;
+  cmSaveAll       = 34;
+  cmSaveDone      = 35;
+  cmChangeDir     = 36;
+  cmDosShell      = 37;
+  cmCloseAll      = 38;
+  cmDelete        = 39;
+  cmEdit          = 40;
+  cmAbout         = 41;
+  cmDesktopLoad   = 42;
+  cmDesktopStore  = 43;
+  cmNewDesktop    = 44;
+  cmNewMenuBar    = 45;
+  cmNewStatusLine = 46;
+  cmNewVideo      = 47;
+  cmTransfer      = 48;
+
+  cmRecordHistory  = 60;
+  cmGrabDefault    = 61;
+  cmReleaseDefault = 62;
+
+  cmHelpContents  = 256;
+  cmHelpIndex     = 257;
+  cmHelpTopic     = 258;
+  cmHelpPrev      = 259;
+  cmHelpUsingHelp = 260;
+  cmHelpAbout     = 261;
+
+  cmBrowseDir     = 262;
+  cmBrowseFile    = 263;
+
+  { Views Unit }
+  cmValid   = 0;
+  cmQuit    = 1;
+  cmError   = 2;
+  cmMenu    = 3;
+  cmClose   = 4;
+  cmZoom    = 5;
+  cmResize  = 6;
+  cmNext    = 7;
+  cmPrev    = 8;
+  cmHelp    = 9;
+  cmOK      = 10;
+  cmCancel  = 11;
+  cmYes     = 12;
+  cmNo      = 13;
+  cmDefault = 14;
+  cmCut     = 20;
+  cmCopy    = 21;
+  cmPaste   = 22;
+  cmUndo    = 23;
+  cmClear   = 24;
+  cmTile    = 25;
+  cmCascade = 26;
+  cmHide    = 27;
+  cmReceivedFocus     = 50;
+  cmReleasedFocus     = 51;
+  cmCommandSetChanged = 52;
+  cmScrollBarChanged  = 53;
+  cmScrollBarClicked  = 54;
+  cmSelectWindowNum   = 55;
+  cmListItemSelected  = 56;
+
+  { ColorSel Unit }
+  cmColorForegroundChanged = 71;
+  cmColorBackgroundChanged = 72;
+  cmColorSet               = 73;
+  cmNewColorItem           = 74;
+  cmNewColorIndex          = 75;
+  cmSaveColorIndex         = 76;
+
+  { StdDlg Unit   800 - ? }
+  cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
+  cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
+  cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
+  cmFileInit    = 803;   { Used by TFileDialog internally }
+  cmRevert      = 805;   { Used by TChDirDialog internally }
+  cmFileFocused = 806;    { A new file was focused in the TFileList }
+  cmFileDoubleClicked = 807;  { A file was selected in the TFileList }
+
+  { Config Unit   130-140, 900-999 }
+  cmConfigMouse       = 130; { Mouse command disabled by Init if no mouse }
+  cmConfigOpen        = 900;
+  cmConfigSave        = 901;
+  cmConfigSaveAs      = 902;
+  cmConfigMenu        = 903;
+  cmConfigColors      = 904;
+  cmConfigVideo       = 905;
+  cmConfigCO80        = 906;
+  cmConfigBW80        = 907;
+  cmConfigMono        = 908;
+  cmClock             = 909;
+  cmClockSetFormat    = 910;
+
+    { Editors Unit }
+  cmFind           = 82;
+  cmReplace        = 83;
+  cmSearchAgain    = 84;
+  cmPrint          = 85;
+  cmRedo           = 86;
+  cmJumpLine       = 87;
+  cmWindowList     = 88;
+  cmCharLeft       = 500;
+  cmCharRight      = 501;
+  cmWordLeft       = 502;
+  cmWordRight      = 503;
+  cmLineStart      = 504;
+  cmLineEnd        = 505;
+  cmLineUp         = 506;
+  cmLineDown       = 507;
+  cmPageUp         = 508;
+  cmPageDown       = 509;
+  cmTextStart      = 510;
+  cmTextEnd        = 511;
+  cmNewLine        = 512;
+  cmBackSpace      = 513;
+  cmDelChar        = 514;
+  cmDelWord        = 515;
+  cmDelStart       = 516;
+  cmDelEnd         = 517;
+  cmDelLine        = 518;
+  cmInsMode        = 519;
+  cmStartSelect    = 520;
+  cmHideSelect     = 521;
+  cmEndSelect      = 522;
+  cmIndentMode     = 523;
+  cmUpdateTitle    = 524;
+  cmReformPara     = 525;
+  cmTabKey         = 526;
+  cmInsertLine     = 527;
+  cmScrollUp       = 528;
+  cmScrollDown     = 529;
+  cmHomePage       = 530;
+  cmEndPage        = 531;
+  cmJumpMark0      = 532;
+  cmJumpMark1      = 533;
+  cmJumpMark2      = 534;
+  cmJumpMark3      = 535;
+  cmJumpMark4      = 536;
+  cmJumpMark5      = 537;
+  cmJumpMark6      = 538;
+  cmJumpMark7      = 539;
+  cmJumpMark8      = 540;
+  cmJumpMark9      = 541;
+  cmReformDoc      = 542;
+  cmSetMark0       = 543;
+  cmSetMark1       = 544;
+  cmSetMark2       = 545;
+  cmSetMark3       = 546;
+  cmSetMark4       = 547;
+  cmSetMark5       = 548;
+  cmSetMark6       = 549;
+  cmSetMark7       = 550;
+  cmSetMark8       = 551;
+  cmSetMark9       = 552;
+  cmSelectWord     = 553;
+  cmSaveExit       = 554;
+  cmCenterText     = 555;
+  cmSetTabs        = 556;
+  cmRightMargin    = 557;
+  cmWordwrap       = 558;
+  cmBludgeonStats  = 559;
+  cmPrinterSetup   = 560;
+  cmClipboard      = 561;
+  cmSpellCheck     = 562;
+  cmCopyBlock      = 563;
+  cmMoveBlock      = 564;
+  cmDelSelect      = 565;
+  cmIdentBlock     = 566;
+  cmUnidentBlock   = 567;
+  cmFileHistory    = 600;
+
+  { Statuses Unit }
+  cmStatusUpdate = 300;  { note - need to set to valid value }
+  cmStatusDone   = 301;
+  cmStatusPause  = 302;
+  cmStatusResume = 303;
+
+  cmCursorChanged = 700;
+
+
+{
+  The HelpCtx unit declares standard help contexts used in FreeVision.  By
+  placing all help contexts in one unit, duplicate help contexts are more
+  easily prevented
+}
+
+const
+
+  hcNoContext = 0;
+  hcDragging = 1;
+  hcOk = 2;
+  hcCancel = 3;
+  hcEdit   = 4;
+  hcDelete = 5;
+  hcInsert = 6;
+
+    { App Unit }
+  hcNew = 65281;        hcFileNew = hcNew;
+  hcOpen = 65282;       hcFileOpen = hcOpen;
+  hcSave = 65283;       hcFileSave = hcSave;
+  hcSaveAs = 65284;     hcFileSaveAs = hcSaveAs;
+  hcSaveAll = 65285;    hcFileSaveAll = hcSaveAll;
+  hcChangeDir = 65286;  hcFileChangeDir = hcChangeDir;
+  hcDosShell = 65287;   hcFileDOSShell = hcDosShell;
+  hcExit = 65288;       hcFileExit = hcExit;
+  hcEditMenu = 65289;
+  hcHelpMenu = 65291;
+  hcHelpContents = 65292;
+  hcHelpIndex = 65293;
+  hcHelpTopic = 65294;
+  hcHelpPrev = 65295;
+  hcHelpUsingHelp = 65296;
+  hcHelpAbout = 65297;
+  hcWindowMenu = 65298;
+  hcUndo         = $FF10;
+  hcCut          = $FF11;
+  hcCopy         = $FF12;
+  hcPaste        = $FF13;
+  hcClear        = $FF14;
+  hcTile         = $FF20;
+  hcCascade      = $FF21;
+  hcCloseAll     = $FF22;
+  hcResize       = $FF23;
+  hcZoom         = $FF24;
+  hcNext         = $FF25;
+  hcPrev         = $FF26;
+  hcClose        = $FF27;
+  hcHide         = $FF28;
+  hcFileMenu     = 65320;
+  hcSearchAndReplace =65325;
+
+    { Editors Unit }
+  hcFile_Menu            = 2100;
+{ hcOpen                 = 2101; }
+{ hcNew                  = 2102; }
+{ hcSave                 = 2103; }
+  hcSaveDone             = 2104;
+{ hcSaveAs               = 2105; }
+{ hcChangeDir            = 2106; }
+{ hcShellToDos           = 2107; }
+{ hcExit                 = 2108; }
+  hcFile_Menu_Items      = hcExit;
+
+  hcEdit_Menu            = 2200;
+{ hcUndo                 = 2201; }
+{ hcCopy                 = 2202; }
+{ hcCut                  = 2203; }
+{ hcPaste                = 2204; }
+  hcClipboard            = 2205;
+{ hcClear                = 2206; }
+  hcSpellCheck           = 2207;
+  hcEdit_Menu_Items      = hcSpellCheck;
+
+  hcSearch_Menu          = 2300;
+  hcFind                 = 2301;
+  hcReplace              = 2302;
+  hcAgain                = 2303;
+  hcSearch_Menu_Items    = hcAgain;
+
+  hcWindows_Menu         = 2400;
+{  hcResize               = 2401; }
+{  hcZoom                 = 2402; }
+{  hcPrev                 = 2403; }
+{  hcNext                 = 2404; }
+{  hcClose                = 2405; }
+{  hcTile                 = 2406; }
+{  hcCascade              = 2407; }
+  hcWindows_Menu_Items   = hcCascade;
+
+  hcDesktop_Menu         = 2500;
+  hcLoadDesktop          = 2501;
+  hcSaveDesktop          = 2502;
+  hcToggleVideo          = 2503;
+  hcDesktop_Menu_Items   = hcToggleVideo;
+
+  hcMisc_Commands        = 2600;
+  hckbShift              = 2601;
+  hckbCtrl               = 2602;
+  hckbAlt                = 2603;
+  hcMisc_Items           = hckbAlt;
+
+  hcEditor_Commands      = 2700;
+  hcCursor               = 2701;
+  hcDeleting             = 2702;
+  hcFormatting           = 2703;
+  hcMarking              = 2704;
+  hcMoving               = 2705;
+  hcSaving               = 2706;
+  hcSelecting            = 2707;
+  hcTabbing              = 2708;
+  hcBackSpace            = 2709;
+  hcCenterText           = 2710;
+  hcCharLeft             = 2711;
+  hcCharRight            = 2712;
+  hcDelChar              = 2713;
+  hcDelEnd               = 2714;
+  hcDelLine              = 2715;
+  hcDelStart             = 2716;
+  hcDelWord              = 2717;
+  hcEndPage              = 2718;
+  hcHideSelect           = 2719;
+  hcHomePage             = 2720;
+  hcIndentMode           = 2721;
+  hcInsertLine           = 2722;
+  hcInsMode              = 2723;
+  hcJumpLine             = 2724;
+  hcLineDown             = 2725;
+  hcLineEnd              = 2726;
+  hcLineStart            = 2727;
+  hcLineUp               = 2728;
+  hcNewLine              = 2729;
+  hcPageDown             = 2730;
+  hcPageUp               = 2731;
+  hcReformDoc            = 2732;
+  hcReformPara           = 2733;
+  hcRightMargin          = 2734;
+  hcScrollDown           = 2735;
+  hcScrollUp             = 2736;
+  hcSearchAgain          = 2737;
+  hcSelectWord           = 2738;
+  hcSetTabs              = 2739;
+  hcStartSelect          = 2740;
+  hcTabKey               = 2741;
+  hcTextEnd              = 2742;
+  hcTextStart            = 2743;
+  hcWordLeft             = 2744;
+  hcWordRight            = 2745;
+  hcWordWrap             = 2746;
+
+  hcJMarker_Menu         = 2750;
+  hcJumpMark1            = 2751;
+  hcJumpMark2            = 2752;
+  hcJumpMark3            = 2753;
+  hcJumpMark4            = 2754;
+  hcJumpMark5            = 2755;
+  hcJumpMark6            = 2756;
+  hcJumpMark7            = 2757;
+  hcJumpMark8            = 2758;
+  hcJumpMark9            = 2759;
+  hcJumpMark0            = 2760;
+  hcJMarker_Menu_Items   = 2761;
+
+  hcSMarker_Menu         = 2770;
+  hcSetMark1             = 2771;
+  hcSetMark2             = 2772;
+  hcSetMark3             = 2773;
+  hcSetMark4             = 2774;
+  hcSetMark5             = 2775;
+  hcSetMark6             = 2776;
+  hcSetMark7             = 2777;
+  hcSetMark8             = 2778;
+  hcSetMark9             = 2779;
+  hcSetMark0             = 2780;
+  hcSMarker_Menu_Items   = 2781;
+
+  hcEditor_Items         = hcSMarker_Menu_Items;
+
+  { Dialog }
+  hcDialogs              = 2800;
+  hcDCancel              = 2801;
+  hcDNo                  = 2802;
+  hcDOk                  = 2803;
+  hcDYes                 = 2804;
+  hcDAbout               = 2805;
+  hcDDirName             = 2806;
+  hcDDirTree             = 2807;
+  hcDChDir               = 2808;
+  hcDRevert              = 2809;
+  hcDName                = 2810;
+  hcDFiles               = 2811;
+  hcDFindText            = 2812;
+  hcDLineNumber          = 2813;
+  hcDReformDoc           = 2814;
+  hcDReplaceTExt         = 2815;
+  hcDRightMargin         = 2816;
+  hcDTabStops            = 2817;
+  hcListDlg              = 2818;
+
+  { Checkbox help }
+  hcCCaseSensitive       = 2900;
+  hcCWholeWords          = 2901;
+  hcCPromptReplace       = 2902;
+  hcCReplaceAll          = 2903;
+  hcCReformCurrent       = 2904;
+  hcCReformEntire        = 2905;
+
+    { Statuses unit }
+  hcStatusPause          = 2950;
+  hcStatusResume         = 2951;
+
+  { Glossary }
+  Glossary               = 3000;
+  GCloseIcon             = 3001;
+  GDesktop               = 3002;
+  GDialogBox             = 3003;
+  GHistoryIcon           = 3004;
+  GInputLine             = 3005;
+  GMemIndicator          = 3006;
+  GMenuBar               = 3007;
+  GPulldownMenu          = 3008;
+  GResizeCorner          = 3009;
+  GSelectedText          = 3010;
+  GStatusBar             = 3011;
+  GTitleBar              = 3012;
+  GWindowBorder          = 3013;
+  GZoomIcon              = 3014;
+  hcGlossary_Items       = GZoomIcon;
+
+    { INI Unit }
+  hcDateFormatDlg = 1;
+  hcDateParts = 1;
+  hcDateOrder = 1;
+  hcTimeFormatDlg = 1;
+  hcClockFormatDlg = 1;
+  hcClockDateParts = 1;
+  hcClockTimeFormat = 1;
+
+  hcListViewer = 1;
+
+  { Options Help Contexts }
+  hcConfigMenu          = 100;
+  hcConfigColors        = hcConfigMenu + 1;
+  hcConfigDate          = hcConfigColors + 1;
+  hcConfigEnvironment   = hcConfigDate + 1;
+  hcConfigMouse         = hcConfigEnvironment + 1;
+  hcConfigOpen          = hcConfigMouse + 1;
+  hcConfigSave          = hcConfigOpen + 1;
+  hcConfigSaveAs        = hcConfigSave + 1;
+  hcConfigTime          = hcConfigSaveAs + 1;
+  hcConfigVideo         = hcConfigTime + 1;
+  hcConfigDesktopDlg    = hcConfigVideo + 1;
+  hcConfigMouseDlg      = hcConfigDesktopDlg + 1;
+  hcConfigTimeFormatDlg = hcConfigMouseDlg + 1;
+  hcConfigTimeSeparator = hcConfigTimeFormatDlg + 1;
+  hcConfigTimeComponents = hcConfigTimeSeparator + 1;
+  hcConfigTimeStyle = hcConfigTimeComponents + 1;
+  hcConfigClock = hcConfigTimeStyle + 1;
+  hcBrowseDir = 1;
+  hcBrowseFile = 1;
+
+
+{
+  The History unit contains all history list constants used in the FreeVision
+  Library.
+}
+
+const
+  hiConfig = 1;
+  hiDirectories = 2;  { non-specific }
+  hiDesktop = 3;
+  hiCurrentDirectories = 1;
+  hiFiles = 4;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:33  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

+ 7 - 3
fvision/gadgets.pas

@@ -95,7 +95,7 @@ UNIT Gadgets;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Time, Objects, Drivers, Views, App;      { Standard GFV units }
+USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                        PUBLIC OBJECT DEFINITIONS                          }
 {                        PUBLIC OBJECT DEFINITIONS                          }
@@ -226,8 +226,12 @@ END;
 END.
 END.
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:21  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:21  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 30 - 7
fvision/histlist.pas

@@ -76,7 +76,7 @@ UNIT HistList;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Objects;                                 { Standard GFV units }
+USES FVCommon, Objects;                                 { Standard GFV units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -112,7 +112,7 @@ FUNCTION HistoryCount (Id: Byte): Word;
 Returns the Index'th string in the history list with ID number Id.
 Returns the Index'th string in the history list with ID number Id.
 30Sep99 LdB
 30Sep99 LdB
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
-FUNCTION HistoryStr (Id: Byte; Index: Integer): String;
+FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
 
 
 {-ClearHistory-------------------------------------------------------
 {-ClearHistory-------------------------------------------------------
 Removes all strings from all history lists.
 Removes all strings from all history lists.
@@ -126,6 +126,8 @@ Adds the string Str to the history list indicated by Id.
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -204,7 +206,7 @@ END;
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE DeleteString;
 PROCEDURE DeleteString;
-VAR Len: Integer; P, P2: PChar;
+VAR Len: Sw_Integer; P, P2: PChar;
 BEGIN
 BEGIN
    P := PChar(CurString);                             { Current string }
    P := PChar(CurString);                             { Current string }
    P2 := PChar(CurString);                            { Current string }
    P2 := PChar(CurString);                            { Current string }
@@ -307,8 +309,8 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
-FUNCTION HistoryStr(Id: Byte; Index: Integer): String;
-VAR I: Integer;
+FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
+VAR I: Sw_Integer;
 BEGIN
 BEGIN
    StartId(Id);                                       { Set to first record }
    StartId(Id);                                       { Set to first record }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
@@ -346,6 +348,23 @@ BEGIN
    InsertString(Id, Str);                             { Add new history item }
    InsertString(Id, Str);                             { Add new history item }
 END;
 END;
 
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+var
+  I: Sw_Integer;
+begin
+  StartId(Id);
+  for I := 0 to Index do
+   AdvanceStringPtr;                                  { Find the string }
+  if CurString <> nil then
+    begin
+       DeleteString;
+       HistoryRemove:=true;
+    end
+  else
+    HistoryRemove:=false;
+end;
+
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -381,8 +400,12 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 304 - 0
fvision/inplong.pas

@@ -0,0 +1,304 @@
+Unit InpLong;
+
+(*--
+TInputLong is a derivitave of TInputline designed to accept LongInt
+numeric input.  Since both the upper and lower limit of acceptable numeric
+input can be set, TInputLong may be used for Integer, Word, or Byte input
+as well.  Option flag bits allow optional hex input and display.  A blank
+field may optionally be rejected or interpreted as zero.
+
+Methods
+
+constructor Init(var R : TRect; AMaxLen : Integer;
+                LowerLim, UpperLim : LongInt; Flgs : Word);
+
+Calls TInputline.Init and saves the desired limits and Flags.  Flags may
+be a combination of:
+
+ilHex          will accept hex input (preceded by '$')  as well as decimal.
+ilBlankEqZero  if set, will interpret a blank field as '0'.
+ilDisplayHex   if set, will display numeric as hex when possible.
+
+
+constructor Load(var S : TStream);
+procedure Store(var S : TStream);
+
+The usual Load and Store routines.  Be sure to call RegisterType(RInputLong)
+to register the type.
+
+
+FUNCTION DataSize : Word; virtual;
+PROCEDURE GetData(var Rec); virtual;
+PROCEDURE SetData(var Rec); virtual;
+
+The transfer methods.  DataSize is Sizeof(LongInt) and Rec should be
+the address of a LongInt.
+
+
+FUNCTION RangeCheck : Boolean; virtual;
+
+Returns True if the entered string evaluates to a number >= LowerLim and
+<= UpperLim.
+
+
+PROCEDURE Error; virtual;
+
+Error is called when RangeCheck fails.  It displays a messagebox indicating
+the label (if any) of the faulting view, as well as the allowable range.
+
+
+PROCEDURE HandleEvent(var Event : TEvent); virtual;
+
+HandleEvent filters out characters which are not appropriate to numeric
+input.  Tab and Shift Tab cause a call to RangeCheck and a call to Error
+if RangeCheck returns false.  The input must be valid to Tab from the view.
+There's no attempt made to stop moving to another view with the mouse.
+
+
+FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+
+if TInputline.Valid is true and Cmd is neither cmValid or cmCancel, Valid
+then calls RangeCheck.  If RangeCheck is false, then Error is called and
+Valid returns False.
+
+----*)
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+Interface
+uses Objects, Drivers, Views, Dialogs, MsgBox;
+
+{flags for TInputLong constructor}
+const
+  ilHex = 1;          {will enable hex input with leading '$'}
+  ilBlankEqZero = 2;  {No input (blank) will be interpreted as '0'}
+  ilDisplayHex = 4;   {Number displayed as hex when possible}
+Type
+  TInputLong = Object(TInputLine)
+    ILOptions : Word;
+    LLim, ULim : LongInt;
+    constructor Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+    constructor Load(var S : TStream);
+    procedure Store(var S : TStream);
+    FUNCTION DataSize : Sw_Word; virtual;
+    PROCEDURE GetData(var Rec); virtual;
+    PROCEDURE SetData(var Rec); virtual;
+    FUNCTION RangeCheck : Boolean; virtual;
+    PROCEDURE Error; virtual;
+    PROCEDURE HandleEvent(var Event : TEvent); virtual;
+    FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+    end;
+  PInputLong = ^TInputLong;
+
+const
+  RInputLong : TStreamRec = (
+    ObjType: 711;
+    VmtLink: Ofs(Typeof(TInputLong)^);
+    Load : @TInputLong.Load;
+    Store : @TInputLong.Store);
+
+Implementation
+
+uses
+  FVConsts;
+
+{-----------------TInputLong.Init}
+constructor TInputLong.Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+begin
+if not TInputLine.Init(R, AMaxLen) then fail;
+ULim := UpperLim;
+LLim := LowerLim;
+if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
+ILOptions := Flgs;
+if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
+end;
+
+{-------------------TInputLong.Load}
+constructor TInputLong.Load(var S : TStream);
+begin
+TInputLine.Load(S);
+S.Read(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.Store}
+procedure TInputLong.Store(var S : TStream);
+begin
+TInputLine.Store(S);
+S.Write(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.DataSize}
+FUNCTION TInputLong.DataSize:Sw_Word;
+begin
+DataSize := Sizeof(LongInt);
+end;
+
+{-------------------TInputLong.GetData}
+PROCEDURE TInputLong.GetData(var Rec);
+var code : Integer;
+begin
+Val(Data^, LongInt(Rec), code);
+end;
+
+FUNCTION Hex2(B : Byte) : String;
+Const
+  HexArray : array[0..15] of char = '0123456789ABCDEF';
+begin
+Hex2[0] := #2;
+Hex2[1] := HexArray[B shr 4];
+Hex2[2] := HexArray[B and $F];
+end;
+
+FUNCTION Hex4(W : Word) : String;
+begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
+
+FUNCTION Hex8(L : LongInt) : String;
+begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
+
+function FormHexStr(L : LongInt) : String;
+var
+  Minus : boolean;
+  S : string[20];
+begin
+Minus := L < 0;
+if Minus then L := -L;
+S := Hex8(L);
+while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
+S := '$' + S;
+if Minus then System.Insert('-', S, 2);
+FormHexStr := S;
+end;
+
+{-------------------TInputLong.SetData}
+PROCEDURE TInputLong.SetData(var Rec);
+var
+  L : LongInt;
+  S : string;
+begin
+L := LongInt(Rec);
+if L > ULim then L := ULim
+else if L < LLim then L := LLim;
+if ILOptions and ilDisplayHex <> 0 then
+  S := FormHexStr(L)
+else
+  Str(L : -1, S);
+if Length(S) > MaxLen then S[0] := chr(MaxLen);
+Data^ := S;
+end;
+
+{-------------------TInputLong.RangeCheck}
+FUNCTION TInputLong.RangeCheck : Boolean;
+var
+  L : LongInt;
+  code : Integer;
+begin
+if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
+  Data^ := '0';
+Val(Data^, L, code);
+RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
+end;
+
+{-------------------TInputLong.Error}
+PROCEDURE TInputLong.Error;
+var
+  SU, SL : string[40];
+  PMyLabel : PLabel;
+  Labl : string;
+  I : Integer;
+
+  function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
+  begin
+  FindIt := (Typeof(P^) = Typeof(TLabel)) and (PLabel(P)^.Link = PView(@Self));
+  end;
+
+begin
+Str(LLim : -1, SL);
+Str(ULim : -1, SU);
+if ILOptions and ilHex <> 0 then
+  begin
+  SL := SL+'('+FormHexStr(LLim)+')';
+  SU := SU+'('+FormHexStr(ULim)+')';
+  end;
+if Owner <> Nil then
+  PMyLabel := PLabel(Owner^.FirstThat(@FindIt))
+else PMyLabel := Nil;
+if PMyLabel <> Nil then PMyLabel^.GetText(Labl)
+else Labl := '';
+if Labl <> '' then
+  begin
+  I := Pos('~', Labl);
+  while I > 0 do
+    begin
+    System.Delete(Labl, I, 1);
+    I := Pos('~', Labl);
+    end;
+  Labl := '"'+Labl+'"';
+  end;
+MessageBox(Labl + ^M^J'Value not within range '+SL+' to '+SU, Nil,
+                            mfError+mfOKButton);
+end;
+
+{-------------------TInputLong.HandleEvent}
+PROCEDURE TInputLong.HandleEvent(var Event : TEvent);
+begin
+if (Event.What = evKeyDown) then
+  begin
+    case Event.KeyCode of
+       kbTab, kbShiftTab
+          : if not RangeCheck then
+              begin
+              Error;
+              SelectAll(True);
+              ClearEvent(Event);
+              end;
+      end;
+  if Event.CharCode <> #0 then  {a character key}
+    begin
+    Event.Charcode := Upcase(Event.Charcode);
+    case Event.Charcode of
+      '0'..'9', #1..#$1B : ;       {acceptable}
+
+      '-'       : if (LLim >= 0) or (CurPos <> 0) then
+                        ClearEvent(Event);
+      '$'       : if ILOptions and ilHex = 0 then ClearEvent(Event);
+      'A'..'F'  : if Pos('$', Data^) = 0 then ClearEvent(Event);
+
+      else ClearEvent(Event);
+      end;
+    end;
+  end;
+TInputLine.HandleEvent(Event);
+end;
+
+{-------------------TInputLong.Valid}
+FUNCTION TInputLong.Valid(Cmd : Word) : Boolean;
+var
+  Rslt : boolean;
+begin
+Rslt := TInputLine.Valid(Cmd);
+if Rslt and (Cmd <> 0) and (Cmd <> cmCancel) then
+  begin
+  Rslt := RangeCheck;
+  if not Rslt then
+    begin
+    Error;
+    Select;
+    SelectAll(True);
+    end;
+  end;
+Valid := Rslt;
+end;
+
+end.

+ 7 - 3
fvision/memory.pas

@@ -75,7 +75,7 @@ UNIT Memory;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common;
+USES FVCommon;
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
 {                            INTERFACE ROUTINES                             }
@@ -828,8 +828,12 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
   * CVS log and ID tags
 
 
 
 
-}
+}

+ 738 - 0
fvision/resource.pas

@@ -0,0 +1,738 @@
+{ Resource Unit
+
+  Programmer: Brad Williams
+  BitSoft Development, L.L.C.
+  Copyright (c) 1996
+  Version 1.1
+
+Revision History
+
+1.1   (12/26/97)
+  - updated to add cdResource directive so that can use standard TStringList
+    resources created by TVRW and TVDT
+
+1.0
+  - original implementation }
+
+unit Resource;
+
+interface
+
+{
+  The Resource unit provides global variables which are used to build and
+  access resource files.  InitRez must always be called before accessing any
+  variables in the Resource unit.  The programmer should also always call
+  Done to free all file handles allocated to the program.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  FVConsts, Objects, Dos;
+
+const
+
+  RezExt: ExtStr = '.RES';
+    { The file extension used on all resource files. }
+  RezBufferSize: Word = 4096;
+    { RezBufferSize is the number of bytes to use for the resource file's
+      stream's buffer.  RezBufferSize is passed to TBufStream.Init. }
+
+    { reXXXX constants are used with resource files to retrieve the standard
+      Free Vision dialogs.  The constant is followed by the Unit in which it
+      is used and the resource which is stored separated by a period. }
+
+  reChDirDialog = 'ChDirDialog';  { StdDlg.TChDirDialog }
+  reEditChDirDialog = 'EditChDirDialog';  { StdDlg.TEditChDirDialog }
+  reFindTextDlg = 'FindTextDlg';  { Editors.CreateFindDialog }
+  reHints = 'Hints'; { Resource.Hints }
+  reJumpLineDlg = 'JumpLineDlg';  { Editors.MakeJumpLineDlg }
+  reLabels = 'Labels';  { Resource.Labels }
+  reMenuBar = 'MenuBar';  { App.MenuBar }
+  reOpenDlg = 'OpenDlg';  { StdDlg.TFileDialog - Open }
+  reReformDocDlg = 'ReformDocDlg';  { Editors.MakeReformDocDlg }
+  reReplaceDlg = 'ReplaceDlg';  { Editors.CreateReplaceDialog }
+  reRightMarginDlg = 'RightMarginDlg';  { Editors.MakeRightMarginDlg }
+  reStatusLine = 'StatusLine';  { App.StatusLine }
+  reStrings = 'Strings';  { Resource.Strings }
+  reSaveAsDlg = 'SaveAsDlg';  { StdDlg.TFileDialog - Save As }
+  reTabStopDlg = 'TabStopDlg';  { Editors.MakeTabStopDlg }
+  reWindowListDlg = 'WindowListDlg';  { Editors.MakeWindowListDlg }
+  reAboutDlg = 'About';  { App unit about dialog }
+
+  {$I str.inc}
+    { STR.INC declares all the string list constants used in the standard
+      Free Vision library units.  They are placed in a separate file as a
+      template for use by the resource file generator, MakeRez.
+
+      Applications which use resource files and need to add strings of their
+      own should use STR.INC as the start for the resource file.
+
+      See MakeRez.PAS for more information about generating resource files.}
+
+type
+
+
+  PConstant = ^TConstant;
+  TConstant = object(TObject)
+    Value: Word;
+      { The value assigned to the constant. }
+    constructor Init (AValue: Word; AText: string);
+      { Init assigns AValue to Value to AText to Text.  AText may be an empty
+        string.
+
+        If an error occurs Init fails. }
+    destructor Done; virtual;
+      { Done disposes of Text then calls the inherited destructor. }
+    procedure SetText (AText: string);
+      { SetText changes FText to the word equivalent of AText. }
+    procedure SetValue (AValue: string);
+      { SetValue changes Value to the word equivalent of AValue. }
+    function Text: string;
+      { Text returns a string equivalent to FText.  If FText is nil, an
+        empty string is returned. }
+    function ValueAsString: string;
+      { ValueAsString returns the string equivalent of Value. }
+      private
+    FText: PString;
+      { The text to display for the constant. }
+  end;  { of TConstant }
+
+
+  PMemStringList = ^TMemStringList;
+  TMemStringList = object(TSortedCollection)
+    { A TMemStringList combines the functions of a TStrListMaker and a
+      TStringList into one object, allowing generation and use of string
+      lists in the same application.  TMemStringList is fully compatible
+      with string lists created using TStrListMaker, so legacy applications
+      will work without problems.
+
+      When using a string list in the same program as it is created, a
+      resource file is not required.  This allows language independant coding
+      of units without the need for conditional defines and recompiling. }
+    constructor Init;
+      { Creates an empty, in-memory string list that is not associated with a
+        resource file. }
+    constructor Load (var S: TStream);
+      { Load creates a TStringList from which it gets its strings upon a call
+        to Get.  The strings on the resource file may be loaded into memory
+        for editing by calling LoadList.
+
+        If initialized with Load, the stream must remain valid for the life
+        of this object. }
+    destructor Done; virtual;
+      { Done deallocates the memory allocated to the string list. }
+    function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
+      { Compare assumes Key1 and Key2 are Word values and returns:
+
+            -1  if Key1 < Key2
+             0  if Key1 = Key2
+             1  if Key1 > Key2 }
+    function Get (Key: Word): String; virtual;
+      { GetKey searches for a string with a key matching Key and returns it.
+        An empty string is returned if a string with a matching Key is not
+        found.
+
+        If Count > 0, the in memory collection is searched.  If List^.Count
+        is 0, the inherited Get method is called. }
+    procedure Insert (Item: Pointer); virtual;
+      { If Item is not nil, Insert attempts to insert the item into the
+        collection.  If a collection expansion error occurs Insert disposes
+        of Item by calling FreeItem.
+
+        Item must be a pointer to a TConstant or its descendant. }
+    function KeyOf (Item: Pointer): Pointer; virtual;
+      { KeyOf returns a pointer to TConstant.Value. }
+    function LoadStrings: Sw_Integer;
+      { LoadStrings reads all strings the associated resource file into
+        memory, places them in the collection, and returns 0.
+
+        If an error occurs LoadStrings returns the stream status error code
+        or a DOS error code.  Possible DOS error codes include:
+
+               2:   no associated resource file
+               8:   out of memory }
+    function NewConstant (Value: Word; S: string): PConstant; virtual;
+      { NewConstant is called by LoadStrings. }
+    procedure Put (Key: Word; S: String); virtual;
+      { Put creates a new PConstant containing Key and Word then calls
+        Insert to place it in the collection. }
+    procedure Store (var S: TStream);
+      { Store creates a TStrListMaker, fills it with the items in List,
+        writes the TStrListMaker to the stream by calling
+        TStrListMaker.Store, then disposes of the TStrListMaker. }
+  private
+    StringList: PStringList;
+  end;  { of TMemStringList) }
+
+
+var
+
+  {$ifdef cdResource}
+  Hints: PStringList;
+  {$else}
+  Hints: PMemStringList;
+  {$endif cdResource}
+    { Hints is a string list for use within the application to provide
+      context sensitive help on the command line.  Hints is always used in
+      the application. }
+
+  {$ifdef cdResource}
+  Strings: PStringList;
+  {$else}
+  Strings: PMemStringList;
+  {$endif cdResource}
+    { Strings holds messages such as errors and general information that are
+      displayed at run-time, normally with MessageBox.  Strings is always
+      used in the application. }
+
+  {$ifdef cdResource}
+  Labels: PStringList;
+  {$else}
+  Labels: PMemStringList;
+  {$endif cdResource}
+    { Labels is a string list for use within the application when a
+      resource file is not used, or when creating a resource file.  Labels
+      contains all text used in dialog titles, labels, buttons, menus,
+      statuslines, etc., used in the application which can be burned into
+      language specific resources.  It does not contain any messages
+      displayed at run-time using MessageBox or the status line hints.
+
+      Using the Labels variable when creating views allows language
+      independant coding of views such as the MessageBox, StdDlg and Editors
+      units. }
+
+  RezFile: PResourceFile;
+    { RezFile is a global variable used when the Free Vision library
+      is compiled using the cdResource conditional define, or when creating
+      resource files.
+
+      All standard Free Vision application resources are accessed from the
+      resource file using the reXXXX constants.  Modify the STR.INC under a
+      new file name to create new language specific resource files.  See the
+      MakeRez program file for more information. }
+
+
+
+procedure DoneResource;
+  { Done destructs all objects initialized in this unit and frees all
+    allocated heap. }
+
+{$ifndef cdResource}
+function InitResource: Boolean;
+{$endif cdResource}
+  { Init initializes the Hints and Strings for use with in memory strings
+    lists.  Init should be used in applications which do not use a resource
+    file, or when creating resource files.  }
+
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+{$endif cdResource}
+  { InitRezFile initializes a new PResourceFile using the name passed in
+    AFile and the stream mode passed in Mode and returns 0.
+
+    If an error occurs InitRezFile returns the DOS error and AResFile is
+    invalid.  Possible DOS error values include:
+
+        2: file not found or other stream initialization error
+        11: invalid format - not a valid resource file }
+
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+{$endif cdResource}
+  { Load is used to open a resource file for use in the application.
+
+    For Load to return True, the resource file must be properly opened and
+    assigned to RezFile and the Hints string list must be successfully loaded
+    from the stream.  If an error occurs, Load displays an English error
+    message using PrintStr and returns False. }
+
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+  { MergeLists moves all key/string pairs from Source to destination,
+    deleting them from Source.  Duplicate strings are ignored. }
+
+
+const
+  RMemStringList: TStreamRec = (
+    ObjType: idMemStringList;
+    VmtLink: Ofs(TypeOf(TMemStringList)^);
+    Load: @TMemStringList.Load;
+    Store: @TMemStringList.Store);
+
+
+implementation
+
+{****************************************************************************}
+{                           Private Declarations                             }
+{****************************************************************************}
+
+uses
+  Memory, Drivers;
+
+{****************************************************************************}
+{ TConstant object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TConstant.Init                                                             }
+{****************************************************************************}
+constructor TConstant.Init (AValue: Word; AText: string);
+begin
+  if not inherited Init then
+    Fail;
+  Value := AValue;
+  FText := NewStr(AText);
+  if (FText = nil) and (AText <> '') then
+  begin
+    inherited Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TConstant.Done                                                             }
+{****************************************************************************}
+destructor TConstant.Done;
+begin
+  DisposeStr(FText);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TConstant.SetText                                                          }
+{****************************************************************************}
+procedure TConstant.SetText (AText: string);
+begin
+  DisposeStr(FText);
+  FText := NewStr(AText);
+end;
+
+{****************************************************************************}
+{ TConstant.SetValue                                                         }
+{****************************************************************************}
+procedure TConstant.SetValue (AValue: string);
+var
+  N: Word;
+  ErrorCode: Integer;
+begin
+  Val(AValue,N,ErrorCode);
+  if ErrorCode = 0 then
+    Value := N;
+end;
+
+{****************************************************************************}
+{ TConstant.Text                                                             }
+{****************************************************************************}
+function TConstant.Text: string;
+begin
+  if (FText = nil) then
+    Text := ''
+  else Text := FText^;
+end;
+
+{****************************************************************************}
+{ TConstant.ValueAsString                                                    }
+{****************************************************************************}
+function TConstant.ValueAsString: string;
+var
+  S: string[5];
+begin
+  Str(Value,S);
+  ValueAsString := S;
+end;
+
+{****************************************************************************}
+{ TMemStringList Object                                                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TMemStringList.Init                                                        }
+{****************************************************************************}
+constructor TMemStringList.Init;
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := nil;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Load                                                        }
+{****************************************************************************}
+constructor TMemStringList.Load (var S: TStream);
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := New(PStringList,Load(S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Done                                                        }
+{****************************************************************************}
+destructor TMemStringList.Done;
+begin
+  if (StringList <> nil) then
+    Dispose(StringList,Done);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Compare                                                     }
+{****************************************************************************}
+function TMemStringList.Compare (Key1, Key2: Pointer): Sw_Integer;
+begin
+  if Word(Key1^) < Word(Key2^) then
+    Compare := -1
+  else Compare := Byte(Word(Key1^) > Word(Key2^));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Get                                                         }
+{****************************************************************************}
+function TMemStringList.Get (Key: Word): string;
+var
+  i: Sw_Integer;
+  S: string;
+begin
+  if (StringList = nil) then
+  begin  { started with Init, use in memory string list }
+    if Search(@Key,i) then
+      Get := PConstant(At(i))^.Text
+    else Get := '';
+  end
+  else begin
+    S := StringList^.Get(Key);
+    Get := S;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Insert                                                      }
+{****************************************************************************}
+procedure TMemStringList.Insert (Item: Pointer);
+var
+  i: Sw_Integer;
+begin
+  if (Item <> nil) then
+  begin
+    i := Count;
+    inherited Insert(Item);
+    if (i = Count) then  { collection expansion failed }
+      Dispose(PConstant(Item),Done);
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.KeyOf                                                       }
+{****************************************************************************}
+function TMemStringList.KeyOf (Item: Pointer): Pointer;
+begin
+  KeyOf := @(PConstant(Item)^.Value);
+end;
+
+{****************************************************************************}
+{ TMemStringList.LoadStrings                                                 }
+{****************************************************************************}
+function TMemStringList.LoadStrings: Sw_Integer;
+  procedure MakeEditableString (var Str: string);
+  const
+    SpecialChars: array[1..3] of Char = #3#10#13;
+  var
+    i, j: Byte;
+  begin
+    for i := 1 to 3 do
+      while (Pos(SpecialChars[i],Str) <> 0) do
+      begin
+        j := Pos(SpecialChars[i],Str);
+        System.Delete(Str,j,1);
+        case i of
+          1: System.Insert('#3',Str,j);
+          2: System.Insert('#10',Str,j);
+          3: System.Insert('#13',Str,j);
+        end;
+      end;
+  end;
+var
+  Constant: PConstant;
+  i: Word;
+  S: string;
+begin
+  LoadStrings := 0;
+  if (StringList = nil) then
+  begin
+    LoadStrings := 2;
+    Exit;
+  end;
+  for i := 0 to 65535 do
+  begin
+    S := StringList^.Get(i);
+    if (S <> '') then
+    begin
+      MakeEditableString(S);
+      Constant := NewConstant(i,S);
+      if LowMemory then
+      begin
+        if (Constant <> nil) then
+          Dispose(Constant,Done);
+        LoadStrings := 8;  { out of memory }
+        Exit;
+      end;
+      Insert(Constant);
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.NewConstant                                                 }
+{****************************************************************************}
+function TMemStringList.NewConstant (Value: Word; S: string): PConstant;
+begin
+  NewConstant := New(PConstant,Init(Value,S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Put                                                         }
+{****************************************************************************}
+procedure TMemStringList.Put (Key: Word; S: string);
+begin
+  Insert(New(PConstant,Init(Key,S)));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Store                                                       }
+{****************************************************************************}
+procedure TMemStringList.Store (var S: TStream);
+var
+  StrList: PStrListMaker;
+  Size: Word;
+  procedure Total (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  begin
+    with Constant^ do
+      Inc(Size,Succ(Length(Text)));
+  end;
+  procedure AddString (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  const
+    Numbers = ['0'..'9'];
+  var
+    i, j: Byte;
+    N: Byte;
+    ErrorCode: Integer;
+    S: string;
+  begin
+    with Constant^ do
+    begin
+        { convert formatting characters }
+      S := Text;
+      while (Pos('#',S) <> 0) do
+      begin
+        i := Succ(Pos('#',S));
+        j := i;
+        if (Length(S) > j) then
+          Inc(j,Byte(S[Succ(j)] in Numbers));
+        Val(Copy(S,i,j-i+1),N,ErrorCode);
+        System.Delete(S,Pred(i),j-i+2);
+        System.Insert(Char(N),S,Pred(i));
+      end;
+      StrList^.Put(Value,Text)
+    end;
+  end;
+begin
+  Size := 0;
+  ForEach(@Total);
+  StrList := New(PStrListMaker,Init(Size,Count * 6));
+  if (StrList = nil) then
+  begin
+    S.Status := 8;  { DOS error not enough memory }
+    Exit;
+  end;
+  ForEach(@AddString);
+  StrList^.Store(S);
+  Dispose(StrList,Done);
+end;
+
+{****************************************************************************}
+{                       Public Procedures and Functions                      }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Done                                                                       }
+{****************************************************************************}
+procedure DoneResource;
+begin
+  if (RezFile <> nil) then
+    begin
+      Dispose(RezFile,Done);
+      RezFile:=nil;
+    end;
+  if (Strings <> nil) then
+    begin
+      Dispose(Strings,Done);
+      Strings:=nil;
+    end;
+  if (Hints <> nil) then
+    begin
+      Dispose(Hints,Done);
+      Hints:=nil;
+    end;
+  if (Labels <> nil) then
+    begin
+      Dispose(Labels,Done);
+      Labels:=nil;
+    end;
+end;
+
+{****************************************************************************}
+{ Init                                                                       }
+{****************************************************************************}
+{$ifndef cdResource}
+
+{$I strtxt.inc}
+  { strtxt.inc contains the real strings and procedures InitRes... which
+    is converted from str.inc }
+
+function InitResource: Boolean;
+begin
+  InitResource := False;
+  Hints := New(PMemStringList,Init);
+  if (Hints = nil) then
+  begin
+    PrintStr('Fatal error.  Could not create Hints list.');
+    Exit;
+  end;
+  Strings := New(PMemStringList,Init);
+  if (Strings = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+  Labels := New(PMemStringList,Init);
+  if (Labels = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+{ now load the defaults }
+  InitResLabels;
+  InitResStrings;
+  InitResource := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ InitRezFile                                                                }
+{****************************************************************************}
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+var
+  Stream: PBufStream;
+  Result: Sw_Integer;
+begin
+  Stream := New(PBufStream,Init(AFile,Mode,RezBufferSize));
+  if (Stream = nil) then
+    Result := 2  { file not found; could also be out of memory }
+  else begin
+    AResFile := New(PResourceFile,Init(Stream));
+    if (AResFile = nil) then
+    begin
+      Dispose(Stream,Done);
+      Result := 11;
+    end
+    else Result := 0;
+  end;
+  InitRezFile := Result;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ Load                                                                       }
+{****************************************************************************}
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+var
+  Stream: PBufStream;
+begin
+  Load := False;
+  Stream := New(PBufStream,Init(AFile,stOpenRead,RezBufferSize));
+  if (Stream = nil) or (Stream^.Status <> 0) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not open resource file: ' + AFile);
+    Exit;
+  end;
+  RezFile := New(PResourceFile,Init(Stream));
+  if (RezFile = nil) then
+  begin
+    Dispose(Stream,Done);
+    Done;
+    PrintStr('Fatal error.  Could not initialize resource file.');
+    Exit;
+  end;
+  Hints := PStringList(RezFile^.Get(reHints));
+  if (Hints = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Hints string list.');
+    Exit;
+  end;
+  Strings := PStringList(RezFile^.Get(reStrings));
+  if (Strings = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Strings string list.');
+    Exit;
+  end;
+  Load := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ MergeLists                                                                 }
+{****************************************************************************}
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+var
+  Result: Sw_Integer;
+  procedure MoveItem (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  var
+    j: Sw_Integer;
+  begin
+    if (Result = 0) and (not Dest^.Search(Dest^.KeyOf(Constant),j)) then
+    begin
+      j := Dest^.Count;
+      Dest^.Insert(Constant);
+      if (j = Dest^.Count) then
+        Result := 8
+      else Source^.Delete(Constant);
+    end;
+  end;
+begin
+  if (Source = nil) or (Dest = nil) then
+  begin
+    MergeLists := 6;
+    Exit;
+  end;
+  Result := 0;
+  Source^.ForEach(@MoveItem);
+  MergeLists := Result;
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+
+begin
+  RezFile := nil;
+  Hints := nil;
+  Strings := nil;
+  Labels := nil;
+end.
+

+ 1402 - 0
fvision/statuses.pas

@@ -0,0 +1,1402 @@
+{$V-}
+unit Statuses;
+
+{#Z+}
+{  Free Vision Status Objects Unit
+   Free VIsion
+   Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3   (96/04/13)
+  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+    Resume "aware"
+  - eliminated many bugs
+  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1    (95/12/6)
+   - minor typo corrections in opening unit documentation
+   - F+ to Z+ around stream registration records
+   - removed redundant sentence in TAppStatus definition
+   - updated CBarStatus documentation and constant
+   - removed TGauge.Init cross-reference from TSpinner.Init
+   - added THeapMemAvail and RegistertvStatus documentation
+   - numerous other documentation updates
+   - changed all calls to Send to Message
+
+1.2.0    (95/11/24)
+   - conversion to Bsd format
+
+1.1.0    (05/01/94)
+   - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+   - sdXXXX constants help documentation doesn't show TStatusDlg and
+     TMessageStatusDlg
+   - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+   - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
+respond to a new message event class, evStatus.  An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  ObjTypes, Objects, Drivers, Views, Dialogs,
+  Resource;
+
+const
+
+  evStatus = $8000;
+    { evStatus represents the event class all status views know how to
+      respond to. }
+    {#X Statuses }
+
+
+  CStatus    =  #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTStatus.CStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{              1    2    3
+           ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CStatus   º  1 ³  2 ³  3 º
+           ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÙ }
+{#F-}
+{#X TStatus }
+
+  CAppStatus =  #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTAppStatus.CAppStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{                 1    2    3
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TAppStatus }
+
+
+  CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTBarGauge.CBarGauge palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{                 1    2    3   4    5
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 ³ 16 ³ 19 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³    ³    ÀÄÄÄÄ filled in bar
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³    ÀÄÄÄÄÄÄÄÄÄ empty bar
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+Ý sdXXXX constants   (STDDLG unit) Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{    Constant      ³ Value ³ Meaning
+ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
+  sdNone          ³ $0000 ³ no buttons
+  sdCancelButton  ³ $0001 ³ show Cancel button
+  sdPauseButton   ³ $0002 ³ show Pause button
+  sdResumeButton  ³ $0004 ³ show Resume button
+  sdAllButtons    ³ $0008 ³ show Cancel, Pause and Resume
+                  ³       ³   buttons }
+{#Z+}
+  sdNone                 = $0000;
+  sdCancelButton         = $0001;
+  sdPauseButton          = $0002;
+  sdResumeButton         = $0004;
+  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+  {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+  SpinChars : String[4] = '³/Ä\';
+    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+      Only one character is displayed at a time.  The string is cycled
+      through then started over again until the view is disposed. }
+    {#X tvStatus }
+
+  sfPause = $F000;
+    { sfPause is an additional state flag used internally by status views to
+      indicate they are in a paused state and should not respond to their
+      command. }
+
+type
+  {#Z+}
+  PStatus = ^TStatus;
+  {#Z-}
+  TStatus = Object(TParamText)
+    { TStatus is the base object type from which all status views descend.
+      Status views are used to display information that will change at
+      run-time based upon some state or process in the application, such as
+      printing.
+
+      All status views that are to be inserted into the application should
+      descend from #TAppStatus# for proper color mapping. }
+    Command : Word;
+      { Command is the only command the status view will respond to.  When
+        the status view receives an evStatus event it checks the value of the
+        Event.Command field against Command before handling the event. }
+      {#X HandleEvent }
+    constructor Init (R : TRect; ACommand : Word; AText : String;
+                      AParamCount : Integer);
+      { Init calls the inherited constructor then sets #Command# to ACommand.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Command# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Store Init }
+    function Cancel : Boolean; virtual;
+      { Cancel should prompt the user when necessary for validation of
+        canceling the process which the status view is displaying.  If the
+        user elects to continue the process Cancel must return False,
+        otherwise Cancel must return True. }
+      {#X Pause Resume }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CStatus#. }
+      {#X TAppStatus CAppStatus }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent captures any #evStatus# messages with its command value
+        equal to #Command#, then calls #Update# with Data set to
+        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
+        view ignores the event. }
+    procedure Pause; virtual;
+      { Pause sends an evStatus message to the application with Event.Command
+        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        #Status# view's sfPause bit of the State flag is set by calling
+        SetState.  In the paused state, the status view does not respond to
+        its associated command. }
+      {#X Resume sdXXXX Cancel }
+    procedure Reset; virtual;
+      { Reset causes the status view to be reset to its beginning or default
+        value, then be redrawn.  Reset is used after an event is aborted
+        which can only be performed in its entirety. }
+    procedure Resume; virtual;
+      { Resume is called in response to pressing the Resume button.  Resume
+        sends an evStatus message to the application with Event.Command set
+        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        Status view's sfPause bit is turned off by calling SetState. }
+      {#X Pause sdXXXX Cancel }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Command# to the
+        stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes the status' displayed text as necessary based on
+        Data. }
+      {#X Command HandleEvent }
+  end;  { of TStatus }
+
+
+  {#Z+}
+  PStatusDlg = ^TStatusDlg;
+  {#Z-}
+  TStatusDlg = Object(TDialog)
+    { A TStatusDlg displays a status view and optional buttons.  It may be
+      used to display any status message and optionally provide end user
+      cancelation or pausing of an ongoing operation, such as printing.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    Status : PStatus;
+      { Status is the key status view for the dialog.  When a cmStatusPause
+        command is broadcast in response to pressing the pause button,
+        Event.InfoPtr is set to point to the command associated with Status. }
+      {#X TStatus cmXXXX }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+      { Init calls the inherited constructor to create the dialog and sets
+        the EventMask to handle #evStatus# events.  AStatus is assigned to
+        #Status# and inserted into the dialog at position 2,2.
+
+        The dialog is anchored at AStatus^.Origin and its size is at least
+        AStatus^.Size + 2 in both dimensions.  The actual size is determined
+        by the AFlags byte.  The #sdXXXX# constants should be used to signify
+        which buttons to display.
+
+        If an error occurs Init fails. }
+      {#X TStatus.Pause TStatus.Resume }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then loads #Status#.
+
+        If an error occurs Load fails. }
+      {#X Store }
+    procedure Cancel (ACommand : Word); virtual;
+      { Cancel sends an evStatus message to the Application object with
+        command set to cmCancel and InfoPtr set to the calling status view's
+        command, then calls the inherited Cancel method. }
+      {#X TBSDDialog.Cancel }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { All evStatus events are accepted by the dialog and sent to each
+        subview in Z-order until cleared.
+
+        If the dialog recieves an evCommand or evBroadcast event with the
+        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+        message to the Application variable with Event.Command set to the
+        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+        disposes of itself.
+
+        When a pause button is included, a cmStatusPause broadcast event is
+        associated with the button.  When the button is pressed a call to
+        #TStatus.Pause# results.  The status view is inactivated until it
+        receives an evStatus event with a commond of cmStatusResume and
+        Event.InfoPtr set to the status view's Command value.  When a pause
+        button is used, the application should respond to the evStatus event
+        (with Event.Command of cmStatusPause) appropriately, then dispatch a
+        cmStatusResume evStatus event when ready to resume activity. }
+      {#X TStatus.Command }
+    procedure InsertButtons (AFlags : Word); virtual;
+      { InsertButtons enlarges the dialog to the necessary size and inserts
+        the buttons specified in AFlags into the last row of the dialog. }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Status# to the
+        stream. }
+      {#X Load }
+  end;  { of TStatusDlg }
+
+
+  {#Z+}
+  PStatusMessageDlg = ^TStatusMessageDlg;
+  {#Z-}
+  TStatusMessageDlg = Object(TStatusDlg)
+    { A TStatusMessageDlg displays a message as static text with a status
+      view on the line below it.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+                      AMessage : String);
+      { Init calls the inherited constructor then inserts a TStaticText view
+        containing AMessage at the top line of the dialog.
+
+        The size of the dialog is determined by the size of the AStatus.  The
+        dialog is anchored at AStatus^.Origin and is of at least
+        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
+        are determined by AOptions.
+
+        AFlags contains flags which determine the buttons to be displayed
+        in the dialog.
+
+        If an error occurs Init fails. }
+  end;  { of TStatusMessageDlg }
+
+
+  {#Z+}
+  PGauge = ^TGauge;
+  {#Z-}
+  TGauge = Object(TStatus)
+    { A gauge is used to represent the current numerical position within a
+      range of values.  When Current equals Max a gauge dispatches an
+      #evStatus# event with the command set to cmStatusDone to the
+      Application object. }
+    Min : LongInt;
+      { Min is the minimum value which #Current# may be set to. }
+      {#X Max }
+    Max : LongInt;
+      { Max is the maximum value which #Current# may be set to. }
+      {#X Min }
+    Current : LongInt;
+      { Current is the current value represented in the gauge. }
+      {#X Max Min }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+      { Init calls the inherited constructor then sets #Min# and #Max# to
+        AMin and AMax, respectively.  #Current# is set to AMin.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Min#, #Max# and
+        #Current# from the stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX  Max = XXX  Current = XXX }
+{#F-}
+      { where XXX are the current values of the corresponding variables. }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+        of the gauge. }
+      {#X SetData }
+    procedure Reset; virtual;
+      { Reset sets #Current# to #Min# then redraws the status view. }
+      {#X TStatus.Reset }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+        accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Min#, #Max# and
+        #Current# to the stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments #Current#. }
+  end;  { of TGauge }
+
+
+  {#Z+}
+  PGaugeRec = ^TGaugeRec;
+  {#Z-}
+  TGaugeRec = record
+    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+    {#X TGauge.GetData TGauge.SetData }
+    Min, Max, Current : LongInt;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PArrowGauge = ^TArrowGauge;
+  {#Z-}
+  TArrowGauge = Object(TGauge)
+    { An arrow gauge draws a progressively larger series of arrows across the
+      view.  If Right is True, the arrows are right facing, '>', and are
+      drawn from left to right.  If Right is False, the arrows are left
+      facing, '<', and are drawn from right to left. }
+    Right : Boolean;
+      { Right determines the direction of arrow used and the direction which
+        the status view is filled.  If Right is True, the arrows are right
+        facing, '>', and are drawn from left to right.  If Right is False,
+        the arrows are left facing, '<', and are drawn from right to left. }
+      {#X Draw }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                      RightArrow : Boolean);
+      { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Right# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw fills the Current / Max percent of the view with arrows. }
+      {#X Right }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+        settings of the views variables. }
+      {#X SetData }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+        variables accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Right# to the
+        stream. }
+      {#X Load }
+  end;  { of TArrowGauge }
+
+
+  {#Z+}
+  PArrowGaugeRec = ^TArrowGaugeRec;
+  {#Z-}
+  TArrowGaugeRec = record
+    { A TArrowGaugeRec is used to set and get the variables of a
+      #TArrowGauge#. }
+    {#X TArrowGauge.GetData TArrowGauge.SetData }
+    Min, Max, Count : LongInt;
+    Right : Boolean;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PPercentGauge = ^TPercentGauge;
+  {#Z-}
+  TPercentGauge = Object(TGauge)
+    { A TPercentGauge displays a numerical percentage as returned by
+      #Percent# followed by a '%' sign. }
+    function Percent : Integer; virtual;
+      { Percent returns the whole number value of (Current / Max) * 100. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Draw; virtual;
+      { Draw writes the current percentage to the screen. }
+      {#X Percent }
+  end;  { of TPercentGauge }
+
+
+  {#Z+}
+  PBarGauge = ^TBarGauge;
+  {#Z-}
+  TBarGauge = Object(TPercentGauge)
+    { A TBarGauge displays a bar which increases in size from the left to
+      the right of the view as Current increases.  A numeric percentage
+      representing the value of (Current / Max) * 100 is displayed in the
+      center of the bar. }
+    {#x TPercentGauge.Percent }
+    procedure Draw; virtual;
+      { Draw draws the bar and percentage to the screen representing the
+        current status of the view's variables. }
+      {#X TGauge.Update }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CBarStatus#. }
+  end;  { of TBarGauge }
+
+
+  {#Z+}
+  PSpinnerGauge = ^TSpinnerGauge;
+  {#Z-}
+  TSpinnerGauge = Object(TGauge)
+    { A TSpinnerGauge displays a series of characters in one spot on the
+      screen giving the illusion of a spinning line. }
+    constructor Init (X, Y : Integer; ACommand : Word);
+      { Init calls the inherited constructor with AMin set to 0 and AMax set
+        to 4. }
+    procedure Draw; virtual;
+      { Draw uses the #SpinChars# variable to draw the view's Current
+        character. }
+      {#X Update }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+        is not generated when Current equals Max. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments Current until Current equals Max, when it resets
+        Current to Min. }
+      {#X Draw HandleEvent }
+  end;  { of TSpinnerGauge }
+
+
+  {#Z+}
+  PAppStatus = ^TAppStatus;
+  {#Z-}
+  TAppStatus = Object(TStatus)
+    { TAppStatus is a base object which implements color control for status
+      views that are normally inserted in the Application object. }
+    {#X TStatus }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default application status view
+        palette, #CAppStatus#. }
+      {#X TStatus CStatus }
+  end;  { of TAppStatus }
+
+
+  {#Z+}
+  PHeapMaxAvail = ^THeapMaxAvail;
+  {#Z-}
+  THeapMaxAvail = Object(TAppStatus)
+    { A THeapMaxAvail displays the largest available contiguous area of heap
+      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
+      comparing the result to #Max#, then updating the view if necessary. }
+    {#X THeapMemAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MaxAvail = xxxx
+
+        where xxxx is the result returned by MaxAvail. }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Max : LongInt;
+      { Max is the last reported value from MaxAvail. }
+      {#X Update }
+  end;  { of THeapMaxAvail }
+
+
+  {#Z+}
+  PHeapMemAvail = ^THeapMemAvail;
+  {#Z-}
+  THeapMemAvail = Object(TAppStatus)
+    { A THeapMemAvail displays the total amount of heap memory available to
+      the application.  It responds to a cmStatusUpdate event by calling
+      MemAvail and comparing the result to #Max#, then updating the view if
+      necessary. }
+    {#X THeapMaxAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MemAvail = xxxx
+
+        where xxxx is the result returned by MemAvail. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Mem : LongInt;
+      { Mem is the last available value reported by MemAvail. }
+      {#X Update }
+  end;  { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+  RStatus    : TStreamRec = (
+     ObjType : idStatus;
+     VmtLink : Ofs(TypeOf(TStatus)^);
+     Load    : @TStatus.Load;
+     Store   : @TStatus.Store);
+
+  RStatusDlg : TStreamRec = (
+     ObjType : idStatusDlg;
+     VmtLink : Ofs(TypeOf(TStatusDlg)^);
+     Load    : @TStatusDlg.Load;
+     Store   : @TStatusDlg.Store);
+
+  RStatusMessageDlg : TStreamRec = (
+     ObjType : idStatusMessageDlg;
+     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+     Load    : @TStatusMessageDlg.Load;
+     Store   : @TStatusMessageDlg.Store);
+
+  RGauge  : TStreamRec = (
+     ObjType : idGauge;
+     VmtLink : Ofs(TypeOf(TGauge)^);
+     Load    : @TGauge.Load;
+     Store   : @TGauge.Store);
+
+  RArrowGauge  : TStreamRec = (
+     ObjType : idArrowGauge;
+     VmtLink : Ofs(TypeOf(TArrowGauge)^);
+     Load    : @TArrowGauge.Load;
+     Store   : @TArrowGauge.Store);
+
+  RBarGauge  : TStreamRec = (
+     ObjType : idBarGauge;
+     VmtLink : Ofs(TypeOf(TBarGauge)^);
+     Load    : @TBarGauge.Load;
+     Store   : @TBarGauge.Store);
+
+  RPercentGauge  : TStreamRec = (
+     ObjType : idPercentGauge;
+     VmtLink : Ofs(TypeOf(TPercentGauge)^);
+     Load    : @TPercentGauge.Load;
+     Store   : @TPercentGauge.Store);
+
+  RSpinnerGauge  : TStreamRec = (
+     ObjType : idSpinnerGauge;
+     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+     Load    : @TSpinnerGauge.Load;
+     Store   : @TSpinnerGauge.Store);
+
+  RAppStatus  : TStreamRec = (
+     ObjType : idAppStatus;
+     VmtLink : Ofs(TypeOf(TAppStatus)^);
+     Load    : @TAppStatus.Load;
+     Store   : @TAppStatus.Store);
+
+  RHeapMinAvail  : TStreamRec = (
+     ObjType : idHeapMinAvail;
+     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+     Load    : @THeapMaxAvail.Load;
+     Store   : @THeapMaxAvail.Store);
+
+  RHeapMemAvail  : TStreamRec = (
+     ObjType : idHeapMemAvail;
+     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+     Load    : @THeapMemAvail.Load;
+     Store   : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+ÝRegisterStatuses procedure   (Statuses unit)Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+  { RegisterStatuses calls RegisterType for each of the status view and
+    status dialog object types defined in the tvStatus unit.  After calling
+    RegisterStatuses, your application can read or write any of those types
+    with streams. }
+
+
+implementation
+
+uses
+  FVConsts, MsgBox, App;
+
+{****************************************************************************}
+{                    Local procedures and functions                          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette                                                      }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object                                                         }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                              RightArrow : Boolean);
+begin
+  if not TGauge.Init(R,ACommand,AMin,AMax) then
+    Fail;
+  Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+  if not TGauge.Load(S) then
+    Fail;
+  S.Read(Right,SizeOf(Right));
+  if (S.Status <> stOk) then
+  begin
+    TGauge.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw                                                           }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of Char = '<>';
+var
+  B : TDrawBuffer;
+  C : Word;
+  Len : Byte;
+begin
+  C := GetColor(1);
+  Len := Round(Size.X * Current/(Max - Min));
+  MoveChar(B,' ',C,Size.X);
+  if Right then
+    MoveChar(B,Arrows[Byte(Right)],C,Len)
+  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+  WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+  PArrowGaugeRec(Rec)^.Min := Min;
+  PArrowGaugeRec(Rec)^.Max := Max;
+  PArrowGaugeRec(Rec)^.Count := Current;
+  PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+  Min := PArrowGaugeRec(Rec)^.Min;
+  Max := PArrowGaugeRec(Rec)^.Max;
+  Current := PArrowGaugeRec(Rec)^.Count;
+  Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store                                                          }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+  TGauge.Store(S);
+  S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw                                                             }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  FillSize : Word;
+  PercentDone : LongInt;
+  S : String[4];
+begin
+  { fill entire view }
+  MoveChar(B,' ',GetColor(4),Size.X);
+  { make progress bar }
+  C := GetColor(5);
+  FillSize := Round(Size.X * (Current / Max));
+  MoveChar(B,' ',C,FillSize);
+  { display percent done }
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  if PercentDone < 50 then
+    C := GetColor(4);
+  FillSize := (Size.X - Length(S)) div 2;
+  MoveStr(B[FillSize],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette                                                       }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+  S : String[Length(CBarGauge)] = CBarGauge;
+begin
+  GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object                                                              }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init                                                                }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+  if not TStatus.Init(R,ACommand,'',1) then
+    Fail;
+  Min := AMin;
+  Max := AMax;
+  Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load                                                                }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+  if not TStatus.Load(S) then
+    Fail;
+  S.Read(Min,SizeOf(Min));
+  S.Read(Max,SizeOf(Max));
+  S.Read(Current,SizeOf(Current));
+  if S.Status <> stOk then
+  begin
+    TStatus.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw                                                                }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+  S : String;
+  B : TDrawBuffer;
+begin
+  { Blank the gauge }
+  MoveChar(B,' ',GetColor(1),Size.X);
+  WriteBuf(0,0,Size.X,Size.Y,B);
+  { write current status }
+  FormatStr(S,'%d',Current);
+  MoveStr(B,S,GetColor(1));
+  WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData                                                             }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+  TGaugeRec(Rec).Min := Min;
+  TGaugeRec(Rec).Max := Max;
+  TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset                                                               }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+  Current := Min;
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData                                                             }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+  Min := TGaugeRec(Rec).Min;
+  Max := TGaugeRec(Rec).Max;
+  Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store                                                               }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+  TStatus.Store(S);
+  S.Write(Min,SizeOf(Min));
+  S.Write(Max,SizeOf(Max));
+  S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update                                                              }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+  if Current < Max then
+  begin
+    Inc(Current);
+    DrawView;
+  end
+  else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+    Fail;
+  Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+  M : LongInt;
+begin
+  M := MaxAvail;
+  if (Max <> M) then
+  begin
+    Max := MaxAvail;
+    SetData(Max);
+  end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+    Fail;
+  Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+  { Total bytes available on the heap.  May not be contiguous. }
+var
+  M : LongInt;
+begin
+  M := MemAvail;
+  if (Mem <> M) then
+  begin
+    Mem := M;
+    SetData(Mem);
+  end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw                                                         }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  S : String;
+  PercentDone : LongInt;
+  FillSize : Integer;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent                                                      }
+{****************************************************************************}
+function TPercentGauge.Percent : Integer;
+  { Returns percent as a whole integer Current of Max }
+begin
+  Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object                                                       }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init                                                         }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
+var R : TRect;
+begin
+  R.Assign(X,Y,X+1,Y+1);
+  if not TGauge.Init(R,ACommand,1,4) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw                                                         }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent                                                  }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+  TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update                                                       }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+  if Current = Max then
+    Current := Min
+  else Inc(Current);
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object                                                             }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init                                                               }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+                          AParamCount : Integer);
+begin
+  if (not TParamText.Init(R,AText,AParamCount)) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load                                                               }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+  if not TParamText.Load(S) then
+    Fail;
+  S.Read(Command,SizeOf(Command));
+  if (S.Status <> stOk) then
+  begin
+    TParamText.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel                                                             }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+  Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette                                                         }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+  P : String[Length(CStatus)] = CStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent                                                        }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+  begin
+    Pause;
+    ClearEvent(Event);
+  end;
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if (Event.InfoPtr = @Self) then
+          begin
+            Message(Owner,evStatus,cmStatusDone,@Self);
+            ClearEvent(Event);
+          end;
+        cmStatusUpdate :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Update(Event.InfoPtr);
+            { ClearEvent(Event); } { don't clear the event so multiple }
+                            { status views can respond to the same event }
+          end;
+        cmStatusResume :
+          if (Event.InfoWord = Command) and
+             ((State and sfPause) = sfPause) then
+          begin
+            Resume;
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Pause;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause                                                              }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+  SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset                                                              }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume                                                             }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+  SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store                                                              }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+  TParamText.Store(S);
+  S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update                                                             }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+  DisposeStr(Text);
+  Text := NewStr(String(Data^));
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                             AFlags : Word);
+var
+  R : TRect;
+  i : LongInt;
+  Buttons : Byte;
+begin
+  if (AStatus = nil) then
+    Fail;
+  R.A := AStatus^.Origin;
+  R.B := AStatus^.Size;
+  Inc(R.B.Y,R.A.Y+4);
+  Inc(R.B.X,R.A.X+5);
+  if not TDialog.Init(R,ATitle) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Status := AStatus;
+  Status^.MoveTo(2,2);
+  Insert(Status);
+  InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  GetSubViewPtr(S,Status);
+  if (S.Status <> stOk) then
+  begin
+    if (Status <> nil) then
+      Dispose(Status,Done);
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel                                                          }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+  if Status^.Cancel then
+    TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent                                                     }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if Event.InfoPtr = Status then
+          begin
+            TDialog.Cancel(cmOk);
+            ClearEvent(Event);
+          end;
+      end;
+      { else let TDialog.HandleEvent send to all subviews for handling }
+    evBroadcast, evCommand :
+      case Event.Command of
+        cmCancel, cmClose :
+          begin
+            Cancel(cmCancel);
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          begin
+            Status^.Pause;
+            ClearEvent(Event);
+          end;
+        cmStatusResume :
+          begin
+            Status^.Resume;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons                                                   }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+  R : TRect;
+  P : PButton;
+  Buttons : Byte;
+  X, Y, Gap : Integer;
+  i : Word;
+begin
+  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+  { do this Inc twice, once for Pause and once for Resume buttons }
+  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+  if Buttons > 0 then
+  begin
+    Status^.GrowMode := gfGrowHiX;
+    { resize dialog to hold all requested buttons }
+    if Size.X < ((Buttons * 12) + 2) then
+      GrowTo((Buttons * 12) + 2,Size.Y + 2)
+    else GrowTo(Size.X,Size.Y + 2);
+    { find correct starting position for first button }
+    Gap := Size.X - (Buttons * 10) - 2;
+    Gap := Gap div Succ(Buttons);
+    X := Gap;
+    if X < 2 then
+      X := 2;
+    Y := Size.Y - 3;
+    { insert buttons }
+    if ((AFlags and sdCancelButton) = sdCancelButton) then
+    begin
+      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+    end;
+    if ((AFlags and sdPauseButton) = sdPauseButton) then
+    begin
+      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+                     bfBroadcast);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+    end;
+  end;  { of if }
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store                                                           }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object                                                   }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init                                                     }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                                    AFlags : Word; AMessage : String);
+var
+  P : PStaticText;
+  X, Y : Integer;
+  R : TRect;
+begin
+  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+    Fail;
+  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+  GetExtent(R);
+  X := R.B.X - R.A.X;
+  if X < Size.X then
+    X := Size.X;
+  Y := R.B.Y - R.A.Y;
+  if Y < Size.Y then
+    Y := Size.Y;
+  GrowTo(X,Y);
+  R.Assign(2,2,Size.X-2,Size.Y-3);
+  P := New(PStaticText,Init(R,AMessage));
+  if (P = nil) then
+  begin
+    TStatusDlg.Done;
+    Fail;
+  end;
+  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+  Insert(P);
+end;
+
+{****************************************************************************}
+{                    Global procedures and functions                         }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses                                                           }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{  RegisterType(RStatus);
+  RegisterType(RStatusDlg);
+  RegisterType(RGauge);
+  RegisterType(RArrowGauge);
+  RegisterType(RPercentGauge);
+  RegisterType(RBarGauge);
+  RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+begin
+end.

+ 2686 - 0
fvision/stddlg.pas

@@ -0,0 +1,2686 @@
+{*******************************************************}
+{ Free Vision Runtime Library                           }
+{ StdDlg Unit                                           }
+{ Version: 0.1.0                                        }
+{ Release Date: July 23, 1998                           }
+{                                                       }
+{*******************************************************}
+{                                                       }
+{ This unit is a port of Borland International's        }
+{ StdDlg.pas unit.  It is for distribution with the     }
+{ Free Pascal (FPK) Compiler as part of the 32-bit      }
+{ Free Vision library.  The unit is still fully         }
+{ functional under BP7 by using the tp compiler         }
+{ directive when rebuilding the library.                }
+{                                                       }
+{*******************************************************}
+
+{ Revision History
+
+1.1a   (97/12/29)
+  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
+    able to have an action taken automatically when the FileList was
+    selected and kbEnter pressed
+
+1.1
+  - modified OpenNewFile to take a history list ID
+  - implemented OpenNewFile
+
+1.0   (1992)
+  - original implementation }
+
+unit StdDlg;
+
+{
+  This unit has been modified to make some functions global, apply patches
+  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
+  several new global functions and procedures.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+{$ifdef OS_DOS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_WINDOWS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_OS2}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+
+interface
+
+uses
+  ObjTypes, Objects, Drivers, Views, Dialogs, Validate, Dos;
+
+const
+{$ifdef PPC_FPC}
+  MaxDir   = 255;   { Maximum length of a DirStr. }
+  MaxFName = 255; { Maximum length of a FNameStr. }
+
+  {$ifdef OS_LINUX}
+  DirSeparator : Char = '/';
+  {$else}
+  DirSeparator : Char = '\';
+  {$endif}
+
+{$else}
+  MaxDir = 67;   { Maximum length of a DirStr. }
+  MaxFName = 79; { Maximum length of a FNameStr. }
+  DirSeparator: Char = '\';
+{$endif}
+
+
+type
+  { TSearchRec }
+
+  {  Record used to store directory information by TFileDialog
+     This is a part of Dos.Searchrec for Bp !! }
+
+  TSearchRec = packed record
+    Attr: Longint;
+    Time: Longint;
+    Size: Longint;
+{$ifdef PPC_FPC}
+    Name: string[255];
+{$else not PPC_FPC}
+    Name: string[12];
+{$endif not PPC_FPC}
+  end;
+  PSearchRec = ^TSearchRec;
+
+type
+
+  { TFileInputLine is a special input line that is used by      }
+  { TFileDialog that will update its contents in response to a  }
+  { cmFileFocused command from a TFileList.          }
+
+  PFileInputLine = ^TFileInputLine;
+  TFileInputLine = object(TInputLine)
+    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileCollection is a collection of TSearchRec's. }
+
+  PFileCollection = ^TFileCollection;
+  TFileCollection = object(TSortedCollection)
+    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  {#Z+}
+  PFileValidator = ^TFileValidator;
+  {#Z-}
+  TFileValidator = Object(TValidator)
+  end;  { of TFileValidator }
+
+  { TSortedListBox is a TListBox that assumes it has a     }
+  { TStoredCollection instead of just a TCollection.  It will   }
+  { perform an incremental search on the contents.       }
+
+  PSortedListBox = ^TSortedListBox;
+  TSortedListBox = object(TListBox)
+    SearchPos: Byte;
+    ShiftState: Byte;
+    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
+      AScrollBar: PScrollBar);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure NewList(AList: PCollection); virtual;
+  end;
+
+  { TFileList is a TSortedList box that assumes it contains     }
+  { a TFileCollection as its collection.  It also communicates  }
+  { through broadcast messages to TFileInput and TInfoPane      }
+  { what file is currently selected.             }
+
+  PFileList = ^TFileList;
+  TFileList = object(TSortedListBox)
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function DataSize: Sw_Word; virtual;
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    procedure GetData(var Rec); virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure ReadDirectory(AWildCard: PathStr);
+    procedure SetData(var Rec); virtual;
+  end;
+
+  { TFileInfoPane is a TView that displays the information      }
+  { about the currently selected file in the TFileList     }
+  { of a TFileDialog.                  }
+
+  PFileInfoPane = ^TFileInfoPane;
+  TFileInfoPane = object(TView)
+    S: TSearchRec;
+    constructor Init(var Bounds: TRect);
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileDialog is a standard file name input dialog      }
+
+  TWildStr = PathStr;
+
+const
+  fdOkButton      = $0001;      { Put an OK button in the dialog }
+  fdOpenButton    = $0002;      { Put an Open button in the dialog }
+  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
+  fdClearButton   = $0008;      { Put a Clear button in the dialog }
+  fdHelpButton    = $0010;      { Put a Help button in the dialog }
+  fdNoLoadDir     = $0100;      { Do not load the current directory }
+            { contents into the dialog at Init. }
+            { This means you intend to change the }
+            { WildCard by using SetData or store }
+            { the dialog on a stream. }
+
+type
+
+  PFileHistory = ^TFileHistory;
+  TFileHistory = object(THistory)
+    CurDir : PString;
+    procedure HandleEvent(var Event: TEvent);virtual;
+    destructor Done; virtual;
+    procedure AdaptHistoryToDir(Dir : string);
+  end;
+
+  PFileDialog = ^TFileDialog;
+  TFileDialog = object(TDialog)
+    FileName: PFileInputLine;
+    FileList: PFileList;
+    FileHistory: PFileHistory;
+    WildCard: TWildStr;
+    Directory: PString;
+    constructor Init(AWildCard: TWildStr; const ATitle,
+      InputName: String; AOptions: Word; HistoryId: Byte);
+    constructor Load(var S: TStream);
+    destructor Done; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure GetFileName(var S: PathStr);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure ReadDirectory;
+  end;
+
+  { TDirEntry }
+
+  PDirEntry = ^TDirEntry;
+  TDirEntry = record
+    DisplayText: PString;
+    Directory: PString;
+  end;  { of TDirEntry }
+
+  { TDirCollection is a collection of TDirEntry's used by       }
+  { TDirListBox.                 }
+
+  PDirCollection = ^TDirCollection;
+  TDirCollection = object(TCollection)
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  { TDirListBox displays a tree of directories for use in the }
+  { TChDirDialog.                    }
+
+  PDirListBox = ^TDirListBox;
+  TDirListBox = object(TListBox)
+    Dir: DirStr;
+    Cur: Word;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function IsSelected(Item: Sw_Integer): Boolean; virtual;
+    procedure NewDirectory(var ADir: DirStr);
+    procedure SetState(AState: Word; Enable: Boolean); virtual;
+  end;
+
+  { TChDirDialog is a standard change directory dialog. }
+
+const
+  cdNormal     = $0000; { Option to use dialog immediately }
+  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
+  cdHelpButton = $0002; { Put a help button in the dialog }
+
+type
+
+  PChDirDialog = ^TChDirDialog;
+  TChDirDialog = object(TDialog)
+    DirInput: PInputLine;
+    DirList: PDirListBox;
+    OkButton: PButton;
+    ChDirButton: PButton;
+    constructor Init(AOptions: Word; HistoryId: Sw_Word);
+    constructor Load(var S: TStream);
+    function DataSize: Sw_Word; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure SetUpDialog;
+  end;
+
+  PEditChDirDialog = ^TEditChDirDialog;
+  TEditChDirDialog = Object(TChDirDialog)
+    { TEditChDirDialog allows setting/getting the starting directory.  The
+      transfer record is a DirStr. }
+    function DataSize : Sw_Word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+  end;  { of TEditChDirDialog }
+
+
+  {#Z+}
+  PDirValidator = ^TDirValidator;
+  {#Z-}
+  TDirValidator = Object(TFilterValidator)
+    constructor Init;
+    function IsValid(const S: string): Boolean; virtual;
+    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+      virtual;
+  end;  { of TDirValidator }
+
+
+  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
+    { Functions of type FileConfirmFunc's are used to prompt the end user for
+      confirmation of an operation.
+
+      FileConfirmFunc's should ask the user whether to perform the desired
+      action on the file named AFile.  If the user elects to perform the
+      function FileConfirmFunc's return True, otherwise they return False.
+
+      Using FileConfirmFunc's allows routines to be coded independant of the
+      user interface implemented.  OWL and TurboVision are supported through
+      conditional defines.  If you do not use either user interface you must
+      compile this unit with the conditional define cdNoMessages and set all
+      FileConfirmFunc variables to a valid function prior to calling any
+      routines in this unit. }
+    {#X ReplaceFile DeleteFile }
+
+
+var
+
+  ReplaceFile : FileConfirmFunc;
+    { ReplaceFile returns True if the end user elects to replace the existing
+      file with the new file, otherwise it returns False.
+
+      ReplaceFile is only called when #CheckOnReplace# is True. }
+    {#X DeleteFile }
+
+  DeleteFile : FileConfirmFunc;
+    { DeleteFile returns True if the end user elects to delete the file,
+      otherwise it returns False.
+
+       DeleteFile is only called when #CheckOnDelete# is True. }
+    {#X ReplaceFile }
+
+
+const
+
+  CInfoPane = #30;
+
+  { TStream registration records }
+
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+
+function DriveValid(Drive: Char): Boolean;
+  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
+    by attempting to change the current directory to Drive, then restoring
+    the original directory. }
+
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+
+function ExtractFileName(AFile: FNameStr): NameStr;
+  { ExtractFileName returns the file name without any directory or file
+    extension information. }
+
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
+    case-insensitive. }
+
+function FileExists (AFile : FNameStr) : Boolean;
+  { FileExists looks for the file specified in AFile.  If AFile is present
+    FileExists returns true, otherwise FileExists returns False.
+
+    The search is performed relative to the current system directory, but
+    other directories may be searched by prefacing a file name with a valid
+    directory path.
+
+    There is no check for a vaild file name or drive.  Errrors are handled
+    internally and not reported in DosError.  Critical errors are left to
+    the system's critical error handler. }
+  {#X OpenFile }
+
+function GetCurDir: DirStr;
+  { GetCurDir returns the current directory.  The directory returned always
+    ends with a trailing backslash '\'. }
+
+function GetCurDrive: Char;
+  { GetCurDrive returns the letter of the current drive as reported by the
+    operating system. }
+
+function IsWild(const S: String): Boolean;
+  { IsWild returns True if S contains a question mark (?) or asterix (*). }
+
+function IsList(const S: String): Boolean;
+  { IsList returns True if S contains list separator (;) char }
+
+function IsDir(const S: String): Boolean;
+  { IsDir returns True if S is a valid DOS directory. }
+
+procedure MakeResources;
+  { MakeResources places a language specific version of all resources
+    needed for the StdDlg unit to function on the RezFile using the string
+    constants and variables in the Resource unit.  The Resource unit and the
+    appropriate string lists must be initialized prior to calling this
+    procedure. }
+
+function NoWildChars(S: String): String;
+  { NoWildChars deletes the wild card characters ? and * from the string S
+    and returns the result. }
+
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+  { OpenFile prompts the user to select a file using the file specifications
+    in AFile as the starting file and path.  Wildcards are accepted.  If the
+    user accepts a file OpenFile returns True, otherwise OpenFile returns
+    False.
+
+    Note: The file returned may or may not exist. }
+
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+
+function PathValid(var Path: PathStr): Boolean;
+  { PathValid returns True if Path is a valid DOS path name.  Path may be a
+    file or directory name.  Trailing '\'s are removed. }
+
+procedure RegisterStdDlg;
+  { RegisterStdDlg registers all objects in the StdDlg unit for stream
+    usage. }
+
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+  { SaveAs prompts the user for a file name using AFile as a template.  If
+    AFile already exists and CheckOnReplace is True, the user is prompted
+    to replace the file.
+
+    If a valid file name is entered SaveAs returns True, other SaveAs returns
+    False. }
+
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+  { SelectDir prompts the user to select a directory using ADir as the
+    starting directory.  If a directory is selected, SelectDir returns True.
+    The directory returned is gauranteed to exist. }
+
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+  { ShrinkPath returns a file name with a maximu length of MaxLen.
+    Internal directories are removed and replaced with elipses as needed to
+    make the file name fit in MaxLen.
+
+    AFile must be a valid path name. }
+
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+  { StdDeleteFile returns True if the end user elects to delete the file,
+    otherwise it returns False.
+
+    DeleteFile is only called when CheckOnDelete is True. }
+
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+  { StdReplaceFile returns True if the end user elects to replace the existing
+    AFile with the new AFile, otherwise it returns False.
+
+    ReplaceFile is only called when CheckOnReplace is True. }
+
+function ValidFileName(var FileName: PathStr): Boolean;
+  { ValidFileName returns True if FileName is a valid DOS file name. }
+
+
+const
+  CheckOnReplace : Boolean = True;
+    { CheckOnReplace is used by file functions.  If a file exists, it is
+      optionally replaced based on the value of CheckOnReplace.
+
+      If CheckOnReplace is False the file is replaced without asking the
+      user.  If CheckOnReplace is True, the end user is asked to replace the
+      file using a call to ReplaceFile.
+
+      CheckOnReplace is set to True by default. }
+
+  CheckOnDelete : Boolean = True;
+    { CheckOnDelete is used by file and directory functions.  If a file
+      exists, it is optionally deleted based on the value of CheckOnDelete.
+
+      If CheckOnDelete is False the file or directory is deleted without
+      asking the user.  If CheckOnDelete is True, the end user is asked to
+      delete the file/directory using a call to DeleteFile.
+
+      CheckOnDelete is set to True by default. }
+
+
+
+const
+  RFileInputLine: TStreamRec = (
+     ObjType: idFileInputLine;
+     VmtLink: Ofs(TypeOf(TFileInputLine)^);
+     Load:    @TFileInputLine.Load;
+     Store:   @TFileInputLine.Store
+  );
+
+  RFileCollection: TStreamRec = (
+     ObjType: idFileCollection;
+     VmtLink: Ofs(TypeOf(TFileCollection)^);
+     Load:    @TFileCollection.Load;
+     Store:   @TFileCollection.Store
+  );
+
+  RFileList: TStreamRec = (
+     ObjType: idFileList;
+     VmtLink: Ofs(TypeOf(TFileList)^);
+     Load:    @TFileList.Load;
+     Store:   @TFileList.Store
+  );
+
+  RFileInfoPane: TStreamRec = (
+     ObjType: idFileInfoPane;
+     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
+     Load:    @TFileInfoPane.Load;
+     Store:   @TFileInfoPane.Store
+  );
+
+  RFileDialog: TStreamRec = (
+     ObjType: idFileDialog;
+     VmtLink: Ofs(TypeOf(TFileDialog)^);
+     Load:    @TFileDialog.Load;
+     Store:   @TFileDialog.Store
+  );
+
+  RDirCollection: TStreamRec = (
+     ObjType: idDirCollection;
+     VmtLink: Ofs(TypeOf(TDirCollection)^);
+     Load:    @TDirCollection.Load;
+     Store:   @TDirCollection.Store
+  );
+
+  RDirListBox: TStreamRec = (
+     ObjType: idDirListBox;
+     VmtLink: Ofs(TypeOf(TDirListBox)^);
+     Load:    @TDirListBox.Load;
+     Store:   @TDirListBox.Store
+  );
+
+  RChDirDialog: TStreamRec = (
+     ObjType: idChDirDialog;
+     VmtLink: Ofs(TypeOf(TChDirDialog)^);
+     Load:    @TChDirDialog.Load;
+     Store:   @TChDirDialog.Store
+  );
+
+  RSortedListBox: TStreamRec = (
+     ObjType: idSortedListBox;
+     VmtLink: Ofs(TypeOf(TSortedListBox)^);
+     Load:    @TSortedListBox.Load;
+     Store:   @TSortedListBox.Store
+  );
+
+  REditChDirDialog : TStreamRec = (
+    ObjType : idEditChDirDialog;
+    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
+    Load    : @TEditChDirDialog.Load;
+    Store   : @TEditChDirDialog.Store);
+
+
+implementation
+
+{****************************************************************************}
+{            Local Declarations              }
+{****************************************************************************}
+
+uses
+  FVConsts, App, Memory, HistList, MsgBox, Resource;
+
+type
+
+  PStringRec = record
+    { PStringRec is needed for properly displaying PStrings using
+      MessageBox. }
+    AString : PString;
+  end;
+
+{****************************************************************************}
+{ TDirValidator Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TDirValidator.Init                    }
+{****************************************************************************}
+constructor TDirValidator.Init;
+const   { What should this list be?  The commented one doesn't allow home,
+  end, right arrow, left arrow, Ctrl+XXXX, etc. }
+  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
+{  Chars: TCharSet = [#0..#255]; }
+begin
+  Chars := Chars + [DirSeparator];
+  if not inherited Init(Chars) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValid                      }
+{****************************************************************************}
+function TDirValidator.IsValid(const S: string): Boolean;
+begin
+{  IsValid := False; }
+  IsValid := True;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValidInput                  }
+{****************************************************************************}
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+begin
+{  IsValid := False; }
+  IsValidInput := True;
+end;
+
+{****************************************************************************}
+{ TFileInputLine Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInputLine.Init                     }
+{****************************************************************************}
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+begin
+  TInputLine.Init(Bounds, AMaxLen);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInputLine.HandleEvent                  }
+{****************************************************************************}
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
+begin
+  TInputLine.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
+    (State and sfSelected = 0) then
+  begin
+     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
+       begin
+          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
+            PFileDialog(Owner)^.WildCard;
+          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
+              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
+       end
+     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
+     DrawView;
+  end;
+end;
+
+{****************************************************************************}
+{ TFileCollection Object                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileCollection.Compare                     }
+{****************************************************************************}
+  function uppername(const s : string) : string;
+  var
+    i  : Sw_integer;
+    in_name : boolean;
+  begin
+     in_name:=true;
+     for i:=length(s) downto 1 do
+      if in_name and (s[i] in ['a'..'z']) then
+        uppername[i]:=char(byte(s[i])-32)
+      else
+       begin
+          uppername[i]:=s[i];
+          if s[i] = DirSeparator then
+            in_name:=false;
+       end;
+     uppername[0]:=s[0];
+  end;
+
+function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
+  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
+  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
+  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
+     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
+  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
+     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
+{$ifdef linux}
+  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
+{$else linux}
+  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
+{$endif def linux}
+    Compare := 1
+  else Compare := -1;
+end;
+
+{****************************************************************************}
+{ TFileCollection.FreeItem                   }
+{****************************************************************************}
+procedure TFileCollection.FreeItem(Item: Pointer);
+begin
+  Dispose(PSearchRec(Item));
+end;
+
+{****************************************************************************}
+{ TFileCollection.GetItem                     }
+{****************************************************************************}
+function TFileCollection.GetItem(var S: TStream): Pointer;
+var
+  Item: PSearchRec;
+begin
+  New(Item);
+  S.Read(Item^, SizeOf(TSearchRec));
+  GetItem := Item;
+end;
+
+{****************************************************************************}
+{ TFileCollection.PutItem                     }
+{****************************************************************************}
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
+begin
+  S.Write(Item^, SizeOf(TSearchRec));
+end;
+
+
+{*****************************************************************************
+               TFileList
+*****************************************************************************}
+
+const
+  ListSeparator=';';
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : Sw_integer;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=char(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : Sw_integer;
+  begin
+    i1:=0;
+    i2:=0;
+    if hstr1='' then
+      begin
+        CmpStr:=(hstr2='');
+        exit;
+      end;
+    found:=true;
+    repeat
+      if found then
+       inc(i2);
+      inc(i1);
+      case hstr1[i1] of
+        '?' :
+          found:=true;
+        '*' :
+          begin
+            found:=true;
+            if (i1=length(hstr1)) then
+             i2:=length(hstr2)
+            else
+             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+              begin
+                if i2<length(hstr2) then
+                 dec(i1)
+              end
+            else
+             if i2>1 then
+              dec(i2);
+          end;
+        else
+          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+      end;
+    until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
+    if found then
+      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef linux}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+function MatchesMaskList(What, MaskList: string): boolean;
+var P: integer;
+    Match: boolean;
+begin
+  Match:=false;
+  if What<>'' then
+  repeat
+    P:=Pos(ListSeparator, MaskList);
+    if P=0 then P:=length(MaskList)+1;
+    Match:=MatchesMask(What,copy(MaskList,1,P-1));
+    Delete(MaskList,1,P);
+  until Match or (MaskList='');
+  MatchesMaskList:=Match;
+end;
+
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  TSortedListBox.Init(Bounds, 2, AScrollBar);
+end;
+
+destructor TFileList.Done;
+begin
+  if List <> nil then Dispose(List, Done);
+  TListBox.Done;
+end;
+
+function TFileList.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+procedure TFileList.FocusItem(Item: Sw_Integer);
+begin
+  TSortedListBox.FocusItem(Item);
+  if (List^.Count > 0) then
+    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
+end;
+
+procedure TFileList.GetData(var Rec);
+begin
+end;
+
+function TFileList.GetKey(var S: String): Pointer;
+const
+  SR: TSearchRec = ();
+
+procedure UpStr(var S: String);
+var
+  I: Sw_Integer;
+begin
+  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
+end;
+
+begin
+  if (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
+    SR.Attr := Directory
+  else SR.Attr := 0;
+  SR.Name := S;
+{$ifndef linux}
+  UpStr(SR.Name);
+{$endif linux}
+  GetKey := @SR;
+end;
+
+function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
+var
+  S: String;
+  SR: PSearchRec;
+begin
+  SR := PSearchRec(List^.At(Item));
+  S := SR^.Name;
+  if SR^.Attr and Directory <> 0 then
+  begin
+    S[Length(S)+1] := DirSeparator;
+    Inc(S[0]);
+  end;
+  GetText := S;
+end;
+
+procedure TFileList.HandleEvent(var Event: TEvent);
+var
+  S : String;
+  K : pointer;
+  Value : Sw_integer;
+begin
+  if (Event.What = evMouseDown) and (Event.Double) then
+  begin
+    Event.What := evCommand;
+    Event.Command := cmOK;
+    PutEvent(Event);
+    ClearEvent(Event);
+  end
+  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
+  begin
+    { select '..' }
+      S := '..';
+      K := GetKey(S);
+      If PSortedCollection(List)^.Search(K, Value) then
+        FocusItem(Value);
+  end
+  else TSortedListBox.HandleEvent(Event);
+end;
+
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
+const
+  FindAttr = ReadOnly + Archive;
+{$ifdef linux}
+  AllFiles = '*';
+{$else}
+  AllFiles = '*.*';
+{$endif}
+  PrevDir  = '..';
+var
+  S: SearchRec;
+  P: PSearchRec;
+  FileList: PFileCollection;
+  NumFiles: Word;
+  FindStr,
+  WildName : string;
+  Dir: DirStr;
+  Ext: ExtStr;
+  Name: NameStr;
+  Event : TEvent;
+  Tmp: PathStr;
+begin
+  NumFiles := 0;
+  FileList := New(PFileCollection, Init(5, 5));
+  AWildCard := FExpand(AWildCard);
+  FSplit(AWildCard, Dir, Name, Ext);
+  if pos(ListSeparator,AWildCard)>0 then
+   begin
+     WildName:=Copy(AWildCard,length(Dir)+1,255);
+     FindStr:=Dir+AllFiles;
+   end
+  else
+   begin
+     WildName:=Name+Ext;
+     FindStr:=AWildCard;
+   end;
+  FindFirst(FindStr, FindAttr, S);
+  P := PSearchRec(@P);
+  while assigned(P) and (DosError = 0) do
+   begin
+     if (S.Attr and Directory = 0) and
+        MatchesMaskList(S.Name,WildName) then
+     begin
+       P := MemAlloc(SizeOf(P^));
+       if assigned(P) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+         FileList^.Insert(P);
+       end;
+     end;
+     FindNext(S);
+   end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+
+  Tmp := Dir + AllFiles;
+  FindFirst(Tmp, Directory, S);
+  while (P <> nil) and (DosError = 0) do
+  begin
+    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
+    begin
+      P := MemAlloc(SizeOf(P^));
+      if P <> nil then
+      begin
+        P^.Attr:=S.Attr;
+        P^.Time:=S.Time;
+        P^.Size:=S.Size;
+        P^.Name:=S.Name;
+        FileList^.Insert(P);
+      end;
+    end;
+    FindNext(S);
+  end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+ {$ifndef linux}
+  if Length(Dir) > 4 then
+ {$endif not linux}
+  begin
+    P := MemAlloc(SizeOf(P^));
+    if P <> nil then
+    begin
+      FindFirst(Tmp, Directory, S);
+      FindNext(S);
+      if (DosError = 0) and (S.Name = PrevDir) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+       end
+      else
+       begin
+         P^.Name := PrevDir;
+         P^.Size := 0;
+         P^.Time := $210000;
+         P^.Attr := Directory;
+       end;
+      FileList^.Insert(PSearchRec(P));
+     {$ifdef fpc}
+      FindClose(S);
+     {$endif}
+    end;
+  end;
+  if P = nil then
+    MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
+  NewList(FileList);
+  if List^.Count > 0 then
+  begin
+    Event.What := evBroadcast;
+    Event.Command := cmFileFocused;
+    Event.InfoPtr := List^.At(0);
+    Owner^.HandleEvent(Event);
+  end;
+end;
+
+procedure TFileList.SetData(var Rec);
+begin
+  with PFileDialog(Owner)^ do
+    Self.ReadDirectory(Directory^ + WildCard);
+end;
+
+{****************************************************************************}
+{ TFileInfoPane Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInfoPane.Init                    }
+{****************************************************************************}
+constructor TFileInfoPane.Init(var Bounds: TRect);
+begin
+  TView.Init(Bounds);
+  FillChar(S,SizeOf(S),#0);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInfoPane.Draw                    }
+{****************************************************************************}
+procedure TFileInfoPane.Draw;
+var
+  B: TDrawBuffer;
+  D: String[9];
+  M: String[3];
+  PM: Boolean;
+  Color: Word;
+  Time: DateTime;
+  Path: PathStr;
+  FmtId: String;
+  Params: array[0..7] of LongInt;
+  Str: String[80];
+const
+  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
+  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
+  InValidFiles : array[0..2] of string[12] = ('','.','..');
+var
+  Month: array[1..12] of String[3];
+begin
+  Month[1] := Strings^.Get(smJan);
+  Month[2] := Strings^.Get(smFeb);
+  Month[3] := Strings^.Get(smMar);
+  Month[4] := Strings^.Get(smApr);
+  Month[5] := Strings^.Get(smMay);
+  Month[6] := Strings^.Get(smJun);
+  Month[7] := Strings^.Get(smJul);
+  Month[8] := Strings^.Get(smAug);
+  Month[9] := Strings^.Get(smSep);
+  Month[10] := Strings^.Get(smOct);
+  Month[11] := Strings^.Get(smNov);
+  Month[12] := Strings^.Get(smDec);
+  { Display path }
+  if (PFileDialog(Owner)^.Directory <> nil) then
+    Path := PFileDialog(Owner)^.Directory^
+  else Path := '';
+  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
+  Color := GetColor($01);
+  MoveChar(B, ' ', Color, Size.X * Size.Y); { fill with empty spaces }
+  WriteLine(0, 0, Size.X, Size.Y, B);
+  MoveStr(B[1], Path, Color);
+  WriteLine(0, 0, Size.X, 1, B);
+  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
+     (S.Name = InValidFiles[2]) then
+    Exit;
+
+  { Display file }
+  Params[0] := LongInt(@S.Name);
+  if S.Attr and Directory <> 0 then
+  begin
+    FmtId := sDirectoryLine;
+    D := Strings^.Get(sDirectory);
+    Params[1] := LongInt(@D);
+  end else
+  begin
+    FmtId := sFileLine;
+    Params[1] := S.Size;
+  end;
+  UnpackTime(S.Time, Time);
+  M := Month[Time.Month];
+  Params[2] := LongInt(@M);
+  Params[3] := Time.Day;
+  Params[4] := Time.Year;
+  PM := Time.Hour >= 12;
+  Time.Hour := Time.Hour mod 12;
+  if Time.Hour = 0 then Time.Hour := 12;
+  Params[5] := Time.Hour;
+  Params[6] := Time.Min;
+  if PM then
+    Params[7] := Byte('p')
+  else Params[7] := Byte('a');
+  FormatStr(Str, FmtId, Params);
+  MoveStr(B, Str, Color);
+  WriteLine(0, 1, Size.X, 1, B);
+
+  { Fill in rest of rectangle }
+  MoveChar(B, ' ', Color, Size.X);
+  WriteLine(0, 2, Size.X, Size.Y-2, B);
+end;
+
+function TFileInfoPane.GetPalette: PPalette;
+const
+  P: String[Length(CInfoPane)] = CInfoPane;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
+  begin
+    S := PSearchRec(Event.InfoPtr)^;
+    DrawView;
+  end;
+end;
+
+{****************************************************************************
+              TFileHistory
+****************************************************************************}
+
+  function LTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := 1;
+    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
+    LTrim := Copy(S, I, 255);
+  end;
+
+  function RTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := Length(S);
+    while S[I] = ' ' do Dec(I);
+    RTrim := Copy(S, 1, I);
+  end;
+
+  function RelativePath(var S: PathStr): Boolean;
+  begin
+    S := LTrim(RTrim(S));
+    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
+  end;
+
+{ try to reduce the length of S+dir as a file path+pattern }
+
+  function Simplify (var S,Dir : string) : string;
+    var i : sw_integer;
+  begin
+   if RelativePath(Dir) then
+     begin
+        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
+          begin
+             i:=Length(S);
+             for i:=Length(S)-1 downto 1 do
+               if S[i]=DirSeparator then
+                 break;
+             if S[i]=DirSeparator then
+               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
+             else
+               Simplify:=S+Dir;
+          end
+        else
+          Simplify:=S+Dir;
+     end
+   else
+      Simplify:=Dir;
+  end;
+
+{****************************************************************************}
+{ TFileHistory.HandleEvent                                                       }
+{****************************************************************************}
+procedure TFileHistory.HandleEvent(var Event: TEvent);
+var
+  HistoryWindow: PHistoryWindow;
+  R,P: TRect;
+  C: Word;
+  Rslt: String;
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evMouseDown) or
+     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
+      (Link^.State and sfFocused <> 0)) then
+  begin
+    if not Link^.Focus then
+    begin
+      ClearEvent(Event);
+      Exit;
+    end;
+    if assigned(CurDir) then
+     Rslt:=CurDir^
+    else
+     Rslt:='';
+    Rslt:=Simplify(Rslt,Link^.Data^);
+    If IsWild(Rslt) then
+      RecordHistory(Rslt);
+    Link^.GetBounds(R);
+    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
+    Owner^.GetExtent(P);
+    R.Intersect(P);
+    Dec(R.B.Y,1);
+    HistoryWindow := InitHistoryWindow(R);
+    if HistoryWindow <> nil then
+    begin
+      C := Owner^.ExecView(HistoryWindow);
+      if C = cmOk then
+      begin
+        Rslt := HistoryWindow^.GetSelection;
+        if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
+        Link^.Data^ := Rslt;
+        Link^.SelectAll(True);
+        Link^.DrawView;
+      end;
+      Dispose(HistoryWindow, Done);
+    end;
+    ClearEvent(Event);
+  end
+  else if (Event.What = evBroadcast) then
+    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
+      or (Event.Command = cmRecordHistory) then
+    begin
+      if assigned(CurDir) then
+       Rslt:=CurDir^
+      else
+       Rslt:='';
+      Rslt:=Simplify(Rslt,Link^.Data^);
+      If IsWild(Rslt) then
+        RecordHistory(Rslt);
+    end;
+end;
+
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
+  var S,S2 : String;
+      i,Count : Sw_word;
+begin
+   if assigned(CurDir) then
+     begin
+        S:=CurDir^;
+        if S=Dir then
+          exit;
+        DisposeStr(CurDir);
+     end
+   else
+     S:='';
+   CurDir:=NewStr(Simplify(S,Dir));
+
+   Count:=HistoryCount(HistoryId);
+   for i:=1 to count do
+     begin
+        S2:=HistoryStr(HistoryId,1);
+        HistoryRemove(HistoryId,1);
+        if RelativePath(S2) then
+          if S<>'' then
+            S2:=S+S2
+          else
+            S2:=FExpand(S2);
+        { simply full path
+          we should simplify relative to Dir ! }
+        HistoryAdd(HistoryId,S2);
+     end;
+
+end;
+
+destructor TFileHistory.Done;
+begin
+  If assigned(CurDir) then
+    DisposeStr(CurDir);
+  Inherited Done;
+end;
+
+{****************************************************************************
+              TFileDialog
+****************************************************************************}
+
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
+  InputName: String; AOptions: Word; HistoryId: Byte);
+var
+  Control: PView;
+  R: TRect;
+  Opt: Word;
+begin
+  R.Assign(15,1,64,20);
+  TDialog.Init(R, ATitle);
+  Options := Options or ofCentered;
+  WildCard := AWildCard;
+
+  R.Assign(3,3,31,4);
+  FileName := New(PFileInputLine, Init(R, 79));
+  FileName^.Data^ := WildCard;
+  Insert(FileName);
+  R.Assign(2,2,3+CStrLen(InputName),3);
+  Control := New(PLabel, Init(R, InputName, FileName));
+  Insert(Control);
+  R.Assign(31,3,34,4);
+  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
+  Insert(FileHistory);
+
+  R.Assign(3,14,34,15);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3,6,34,14);
+  FileList := New(PFileList, Init(R, PScrollBar(Control)));
+  Insert(FileList);
+  R.Assign(2,5,8,6);
+  Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
+  Insert(Control);
+
+  R.Assign(35,3,46,5);
+  Opt := bfDefault;
+  if AOptions and fdOpenButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdOkButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdReplaceButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdClearButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  if AOptions and fdHelpButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+
+  R.Assign(1,16,48,18);
+  Control := New(PFileInfoPane, Init(R));
+  Insert(Control);
+
+  SelectNext(False);
+
+  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
+end;
+
+constructor TFileDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(WildCard, SizeOf(TWildStr));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S, FileName);
+  GetSubViewPtr(S, FileList);
+  GetSubViewPtr(S, FileHistory);
+  ReadDirectory;
+  if (DosError <> 0) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+destructor TFileDialog.Done;
+begin
+  DisposeStr(Directory);
+  TDialog.Done;
+end;
+
+procedure TFileDialog.GetData(var Rec);
+begin
+  GetFilename(PathStr(Rec));
+end;
+
+procedure TFileDialog.GetFileName(var S: PathStr);
+
+var
+  Path: PathStr;
+  Name: NameStr;
+  Ext: ExtStr;
+  TWild : string;
+  TPath: PathStr;
+  TName: NameStr;
+  TExt: NameStr;
+  i : Sw_integer;
+begin
+  S := FileName^.Data^;
+  if RelativePath(S) then
+    begin
+      if (Directory <> nil) then
+   S := FExpand(Directory^ + S);
+    end
+  else
+    S := FExpand(S);
+  if Pos(ListSeparator,S)=0 then
+   begin
+     If FileExists(S) then
+       exit;
+     FSplit(S, Path, Name, Ext);
+     if ((Name = '') or (Ext = '')) and not IsDir(S) then
+     begin
+       TWild:=WildCard;
+       repeat
+    i:=Pos(ListSeparator,TWild);
+    if i=0 then
+     i:=length(TWild)+1;
+    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
+    if ((Name = '') and (Ext = '')) then
+      S := Path + TName + TExt
+    else
+      if Name = '' then
+        S := Path + TName + Ext
+      else
+        if Ext = '' then
+          begin
+       if IsWild(Name) then
+         S := Path + Name + TExt
+       else
+         S := Path + Name + NoWildChars(TExt);
+          end;
+    if FileExists(S) then
+     break;
+    System.Delete(TWild,1,i);
+       until TWild='';
+       if TWild='' then
+         S := Path + Name + Ext;
+     end;
+   end;
+end;
+
+procedure TFileDialog.HandleEvent(var Event: TEvent);
+begin
+  if (Event.What and evBroadcast <> 0) and
+     (Event.Command = cmListItemSelected) then
+  begin
+    EndModal(cmFileOpen);
+    ClearEvent(Event);
+  end;
+  TDialog.HandleEvent(Event);
+  if Event.What = evCommand then
+    case Event.Command of
+      cmFileOpen, cmFileReplace, cmFileClear:
+   begin
+     EndModal(Event.Command);
+     ClearEvent(Event);
+   end;
+    end;
+end;
+
+procedure TFileDialog.SetData(var Rec);
+begin
+  TDialog.SetData(Rec);
+  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
+  begin
+    Valid(cmFileInit);
+    FileName^.Select;
+  end;
+end;
+
+procedure TFileDialog.ReadDirectory;
+begin
+  FileList^.ReadDirectory(WildCard);
+  FileHistory^.AdaptHistoryToDir(GetCurDir);
+  Directory := NewStr(GetCurDir);
+end;
+
+procedure TFileDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  S.Write(WildCard, SizeOf(TWildStr));
+  PutSubViewPtr(S, FileName);
+  PutSubViewPtr(S, FileList);
+  PutSubViewPtr(S, FileHistory);
+end;
+
+function TFileDialog.Valid(Command: Word): Boolean;
+var
+  FName: PathStr;
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+
+  function CheckDirectory(var S: PathStr): Boolean;
+  begin
+    if not PathValid(S) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
+      FileName^.Select;
+      CheckDirectory := False;
+    end else CheckDirectory := True;
+  end;
+
+  function CompleteDir(const Path: string): string;
+  begin
+    { keep c: untouched PM }
+    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
+       (Path[Length(Path)]<>':') then
+     CompleteDir:=Path+DirSeparator
+    else
+     CompleteDir:=Path;
+  end;
+
+  function NormalizeDir(const Path: string): string;
+  var Root: boolean;
+  begin
+    Root:=false;
+    {$ifdef Linux}
+    if Path=DirSeparator then Root:=true;
+    {$else}
+    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
+       (Path[2]=':') and (Path[3]=DirSeparator) then
+         Root:=true;
+    {$endif}
+    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
+      NormalizeDir:=copy(Path,1,length(Path)-1)
+    else
+      NormalizeDir:=Path;
+  end;
+function NormalizeDirF(var S: openstring): boolean;
+begin
+  S:=NormalizeDir(S);
+  NormalizeDirF:=true;
+end;
+
+begin
+  if Command = 0 then
+  begin
+    Valid := True;
+    Exit;
+  end
+  else Valid := False;
+  if TDialog.Valid(Command) then
+  begin
+    GetFileName(FName);
+    if (Command <> cmCancel) and (Command <> cmFileClear) then
+    begin
+      if IsWild(FName) or IsList(FName) then
+      begin
+        FSplit(FName, Dir, Name, Ext);
+        if CheckDirectory(Dir) then
+        begin
+          FileHistory^.AdaptHistoryToDir(Dir);
+          DisposeStr(Directory);
+          Directory := NewStr(Dir);
+          if Pos(ListSeparator,FName)>0 then
+           WildCard:=Copy(FName,length(Dir)+1,255)
+          else
+           WildCard := Name+Ext;
+          if Command <> cmFileInit then
+            FileList^.Select;
+          FileList^.ReadDirectory(Directory^+WildCard);
+        end;
+      end
+    else
+      if NormalizeDirF(FName) then
+      { ^^ this is just a dummy if construct (the func always returns true,
+        it's just there, 'coz I don't want to rearrange the following "if"s... }
+      if IsDir(FName) then
+        begin
+          if CheckDirectory(FName) then
+          begin
+            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
+            DisposeStr(Directory);
+            Directory := NewSTr(CompleteDir(FName));
+            if Command <> cmFileInit then FileList^.Select;
+            FileList^.ReadDirectory(Directory^+WildCard);
+          end
+        end
+      else
+        if ValidFileName(FName) then
+          Valid := True
+        else
+          begin
+            MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
+            Valid := False;
+          end;
+    end
+    else Valid := True;
+  end;
+end;
+
+{ TDirCollection }
+
+function TDirCollection.GetItem(var S: TStream): Pointer;
+var
+  DirItem: PDirEntry;
+begin
+  New(DirItem);
+  DirItem^.DisplayText := S.ReadStr;
+  DirItem^.Directory := S.ReadStr;
+  GetItem := DirItem;
+end;
+
+procedure TDirCollection.FreeItem(Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  DisposeStr(DirItem^.DisplayText);
+  DisposeStr(DirItem^.Directory);
+  Dispose(DirItem);
+end;
+
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  S.WriteStr(DirItem^.DisplayText);
+  S.WriteStr(DirItem^.Directory);
+end;
+
+{ TDirListBox }
+
+const
+  DrivesS: String = '';
+  Drives: PString = @DrivesS;
+
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
+  PScrollBar);
+begin
+  DrivesS := strings^.get(sDrives);
+  TListBox.Init(Bounds, 1, AScrollBar);
+  Dir := '';
+end;
+
+destructor TDirListBox.Done;
+begin
+  if (List <> nil) then
+    Dispose(List,Done);
+  TListBox.Done;
+end;
+
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
+begin
+  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
+end;
+
+procedure TDirListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown:
+      if Event.Double then
+      begin
+   Event.What := evCommand;
+   Event.Command := cmChangeDir;
+   PutEvent(Event);
+   ClearEvent(Event);
+      end;
+    evKeyboard:
+      if (Event.CharCode = ' ') and
+    (PSearchRec(List^.At(Focused))^.Name = '..') then
+   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
+  end;
+  TListBox.HandleEvent(Event);
+end;
+
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
+begin
+  IsSelected := Item = Cur;
+end;
+
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
+const
+  PathDir       = 'ÀÄÂ';
+  FirstDir     =   'ÀÂÄ';
+  MiddleDir   =   ' ÃÄ';
+  LastDir       =   ' ÀÄ';
+  IndentSize    = '  ';
+var
+  AList: PCollection;
+  NewDir, Dirct: DirStr;
+  C, OldC: Char;
+  S, Indent: String[80];
+  P: PString;
+  isFirst: Boolean;
+  SR: SearchRec;
+  I: Sw_Integer;
+
+  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
+  var
+    DirEntry: PDirEntry;
+  begin
+    New(DirEntry);
+    DirEntry^.DisplayText := NewStr(DisplayText);
+    DirEntry^.Directory := NewStr(Directory);
+    NewDirEntry := DirEntry;
+  end;
+
+begin
+  Dir := ADir;
+  AList := New(PDirCollection, Init(5,5));
+{$ifdef HAS_DOS_DRIVES}
+  AList^.Insert(NewDirEntry(Drives^,Drives^));
+  if Dir = Drives^ then
+  begin
+    isFirst := True;
+    OldC := ' ';
+    for C := 'A' to 'Z' do
+    begin
+      if (C < 'C') or DriveValid(C) then
+      begin
+   if OldC <> ' ' then
+   begin
+     if isFirst then
+     begin
+       S := FirstDir + OldC;
+       isFirst := False;
+     end
+     else S := MiddleDir + OldC;
+     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
+   end;
+   if C = GetCurDrive then Cur := AList^.Count;
+   OldC := C;
+      end;
+    end;
+    if OldC <> ' ' then
+      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
+  end
+  else
+{$endif HAS_DOS_DRIVES}
+  begin
+    Indent := IndentSize;
+    NewDir := Dir;
+{$ifdef HAS_DOS_DRIVES}
+    Dirct := Copy(NewDir,1,3);
+    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
+    NewDir := Copy(NewDir,4,255);
+{$else HAS_DOS_DRIVES}
+    Dirct := '';
+{$endif HAS_DOS_DRIVES}
+    while NewDir <> '' do
+    begin
+      I := Pos(DirSeparator,NewDir);
+      if I <> 0 then
+      begin
+   S := Copy(NewDir,1,I-1);
+   Dirct := Dirct + S;
+   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
+   NewDir := Copy(NewDir,I+1,255);
+      end
+      else
+      begin
+   Dirct := Dirct + NewDir;
+   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
+   NewDir := '';
+      end;
+      Indent := Indent + IndentSize;
+      Dirct := Dirct + DirSeparator;
+    end;
+    Cur := AList^.Count-1;
+    isFirst := True;
+    NewDir := Dirct + '*.*';
+    FindFirst(NewDir, Directory, SR);
+    while DosError = 0 do
+    begin
+      if (SR.Attr and Directory <> 0) and
+{$ifdef FPC}
+         (SR.Name <> '.') and (SR.Name <> '..') then
+{$else : not FPC}
+         (SR.Name[1] <> '.') then
+{$endif not FPC}
+      begin
+   if isFirst then
+   begin
+     S := FirstDir;
+     isFirst := False;
+   end else S := MiddleDir;
+   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
+      end;
+      FindNext(SR);
+    end;
+ {$ifdef fpc}
+  FindClose(SR);
+ {$endif}
+    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
+    I := Pos('À',P^);
+    if I = 0 then
+    begin
+      I := Pos('Ã',P^);
+      if I <> 0 then P^[I] := 'À';
+    end else
+    begin
+      P^[I+1] := 'Ä';
+      P^[I+2] := 'Ä';
+    end;
+  end;
+  NewList(AList);
+  FocusItem(Cur);
+end;
+
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
+begin
+  TListBox.SetState(AState, Enable);
+  if AState and sfFocused <> 0 then
+    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
+end;
+
+{****************************************************************************}
+{ TChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TChDirDialog.Init                      }
+{****************************************************************************}
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
+var
+  R: TRect;
+  Control: PView;
+begin
+  R.Assign(16, 2, 64, 20);
+  TDialog.Init(R,strings^.get(sChangeDirectory));
+
+  Options := Options or ofCentered;
+
+  R.Assign(3, 3, 30, 4);
+  DirInput := New(PInputLine, Init(R, 68));
+  Insert(DirInput);
+  R.Assign(2, 2, 17, 3);
+  Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
+  Insert(Control);
+  R.Assign(30, 3, 33, 4);
+  Control := New(PHistory, Init(R, DirInput, HistoryId));
+  Insert(Control);
+
+  R.Assign(32, 6, 33, 16);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3, 6, 32, 16);
+  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
+  Insert(DirList);
+  R.Assign(2, 5, 17, 6);
+  Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
+  Insert(Control);
+
+  R.Assign(35, 6, 45, 8);
+  OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
+  Insert(OkButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
+           bfNormal));
+  Insert(ChDirButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
+  if AOptions and cdHelpButton <> 0 then
+  begin
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+    Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
+  end;
+
+  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
+
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Load                      }
+{****************************************************************************}
+constructor TChDirDialog.Load(var S: TStream);
+begin
+  TDialog.Load(S);
+  GetSubViewPtr(S, DirList);
+  GetSubViewPtr(S, DirInput);
+  GetSubViewPtr(S, OkButton);
+  GetSubViewPtr(S, ChDirbutton);
+  SetUpDialog;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.DataSize                      }
+{****************************************************************************}
+function TChDirDialog.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.GetData                        }
+{****************************************************************************}
+procedure TChDirDialog.GetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.HandleEvent                   }
+{****************************************************************************}
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
+var
+  CurDir: DirStr;
+  P: PDirEntry;
+begin
+  TDialog.HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+   case Event.Command of
+     cmRevert: GetDir(0,CurDir);
+     cmChangeDir:
+       begin
+         P := DirList^.List^.At(DirList^.Focused);
+         if (P^.Directory^ = Drives^)
+            or DriveValid(P^.Directory^[1]) then
+           CurDir := P^.Directory^
+         else Exit;
+       end;
+   else
+     Exit;
+   end;
+   if (Length(CurDir) > 3) and
+      (CurDir[Length(CurDir)] = DirSeparator) then
+     CurDir := Copy(CurDir,1,Length(CurDir)-1);
+   DirList^.NewDirectory(CurDir);
+   DirInput^.Data^ := CurDir;
+   DirInput^.DrawView;
+   DirList^.Select;
+   ClearEvent(Event);
+      end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetData                        }
+{****************************************************************************}
+procedure TChDirDialog.SetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetUpDialog                   }
+{****************************************************************************}
+procedure TChDirDialog.SetUpDialog;
+var
+  CurDir: DirStr;
+begin
+  if DirList <> nil then
+  begin
+    CurDir := GetCurDir;
+    DirList^.NewDirectory(CurDir);
+    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+      CurDir := Copy(CurDir,1,Length(CurDir)-1);
+    if DirInput <> nil then
+    begin
+      DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Store                    }
+{****************************************************************************}
+procedure TChDirDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S, DirList);
+  PutSubViewPtr(S, DirInput);
+  PutSubViewPtr(S, OkButton);
+  PutSubViewPtr(S, ChDirButton);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Valid                    }
+{****************************************************************************}
+function TChDirDialog.Valid(Command: Word): Boolean;
+var
+  P: PathStr;
+begin
+  Valid := True;
+  if Command = cmOk then
+  begin
+    P := FExpand(DirInput^.Data^);
+    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
+      Dec(P[0]);
+    {$I-}
+    ChDir(P);
+    if (IOResult <> 0) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
+      Valid := False;
+    end;
+    {$I+}
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TEditChDirDialog.DataSize                    }
+{****************************************************************************}
+function TEditChDirDialog.DataSize : Sw_Word;
+begin
+  DataSize := SizeOf(DirStr);
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.GetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.GetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if (DirInput = nil) then
+    CurDir := ''
+  else begin
+    CurDir := DirInput^.Data^;
+    if (CurDir[Length(CurDir)] <> DirSeparator) then
+      CurDir := CurDir + DirSeparator;
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.SetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.SetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if DirList <> nil then
+  begin
+    DirList^.NewDirectory(CurDir);
+    if DirInput <> nil then
+    begin
+      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
+      else DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TSortedListBox Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TSortedListBox.Init                     }
+{****************************************************************************}
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
+  AScrollBar: PScrollBar);
+begin
+  TListBox.Init(Bounds, ANumCols, AScrollBar);
+  SearchPos := 0;
+  ShowCursor;
+  SetCursor(1,0);
+end;
+
+{****************************************************************************}
+{ TSortedListBox.HandleEvent                  }
+{****************************************************************************}
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
+const
+  SpecialChars: set of Char = [#0,#9,#27];
+var
+  CurString, NewString: String;
+  K: Pointer;
+  Value : Sw_integer;
+  OldPos, OldValue: Sw_Integer;
+  T: Boolean;
+begin
+  OldValue := Focused;
+  TListBox.HandleEvent(Event);
+  if (OldValue <> Focused) or
+     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
+      (Event.Command = cmReleasedFocus)) then
+    SearchPos := 0;
+  if Event.What = evKeyDown then
+  begin
+    { patched to prevent error when no or empty list or Escape pressed }
+    if (not (Event.CharCode in SpecialChars)) and
+       (List <> nil) and (List^.Count > 0) then
+    begin
+      Value := Focused;
+      if Value < Range then CurString := GetText(Value, 255)
+      else CurString := '';
+      OldPos := SearchPos;
+      if Event.KeyCode = kbBack then
+      begin
+   if SearchPos = 0 then Exit;
+   Dec(SearchPos);
+   if SearchPos = 0 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+      end
+      else if (Event.CharCode = '.') then SearchPos := Pos('.',CurString)
+      else
+      begin
+   Inc(SearchPos);
+   if SearchPos = 1 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+   CurString[SearchPos] := Event.CharCode;
+      end;
+      K := GetKey(CurString);
+      T := PSortedCollection(List)^.Search(K, Value);
+      if Value < Range then
+      begin
+   if Value < Range then NewString := GetText(Value, 255)
+   else NewString := '';
+   if Equal(NewString, CurString, SearchPos) then
+   begin
+     if Value <> OldValue then
+     begin
+       FocusItem(Value);
+       { Assumes ListControl will set the cursor to the first character }
+       { of the sfFocused item }
+       SetCursor(Cursor.X+SearchPos, Cursor.Y);
+     end
+     else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
+   end
+   else SearchPos := OldPos;
+      end
+      else SearchPos := OldPos;
+      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
+   ClearEvent(Event);
+    end
+  end;
+end;
+
+function TSortedListBox.GetKey(var S: String): Pointer;
+begin
+  GetKey := @S;
+end;
+
+procedure TSortedListBox.NewList(AList: PCollection);
+begin
+  TListBox.NewList(AList);
+  SearchPos := 0;
+end;
+
+{****************************************************************************}
+{            Global Procedures and Functions          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Contains                          }
+{****************************************************************************}
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+var
+  i : Byte;
+begin
+  Contains := True;
+  i := 1;
+  while ((i < Length(S2)) and (i < Length(S1))) do
+    if (Upcase(S1[i]) = Upcase(S2[i])) then
+      Exit
+    else Inc(i);
+  Contains := False;
+end;
+
+{****************************************************************************}
+{ StdDeleteFile                           }
+{****************************************************************************}
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnDelete then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
+               @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdDeleteFile := False;
+end;
+
+{****************************************************************************}
+{ DriveValid                         }
+{****************************************************************************}
+function DriveValid(Drive: Char): Boolean;
+{$ifdef HAS_DOS_DRIVES}
+var
+  D: Char;
+begin
+  D := GetCurDrive;
+  {$I-}
+  ChDir(Drive+':');
+  if (IOResult = 0) then
+  begin
+    DriveValid := True;
+    ChDir(D+':')
+  end
+  else DriveValid := False;
+  {$I+}
+end;
+{$else HAS_DOS_DRIVES}
+begin
+  DriveValid:=true;
+end;
+{$endif HAS_DOS_DRIVES}
+
+{****************************************************************************}
+{ Equal                             }
+{****************************************************************************}
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+var
+  i: Sw_Word;
+begin
+  Equal := False;
+  if (Length(S1) < Count) or (Length(S2) < Count) then
+    Exit;
+  for i := 1 to Count do
+    if UpCase(S1[I]) <> UpCase(S2[I]) then
+      Exit;
+  Equal := True;
+end;
+
+{****************************************************************************}
+{ ExtractDir                         }
+{****************************************************************************}
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  if D = '' then
+  begin
+    ExtractDir := '';
+    Exit;
+  end;
+  if D[Byte(D[0])] <> DirSeparator then
+    D := D + DirSeparator;
+  ExtractDir := D;
+end;
+
+{****************************************************************************}
+{ ExtractFileName                       }
+{****************************************************************************}
+function ExtractFileName(AFile: FNameStr): NameStr;
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  ExtractFileName := N;
+end;
+
+{****************************************************************************}
+{ FileExists                         }
+{****************************************************************************}
+function FileExists (AFile : FNameStr) : Boolean;
+begin
+  FileExists := (FSearch(AFile,'') <> '');
+end;
+
+{****************************************************************************}
+{ GetCurDir                        }
+{****************************************************************************}
+function GetCurDir: DirStr;
+var
+  CurDir: DirStr;
+begin
+  GetDir(0, CurDir);
+  if (Length(CurDir) > 3) then
+  begin
+    Inc(CurDir[0]);
+    CurDir[Length(CurDir)] := DirSeparator;
+  end;
+  GetCurDir := CurDir;
+end;
+
+{****************************************************************************}
+{ GetCurDrive                       }
+{****************************************************************************}
+function GetCurDrive: Char;
+{$ifdef go32v2}
+var
+  Regs : Registers;
+begin
+  Regs.AH := $19;
+  Intr($21,Regs);
+  GetCurDrive := Char(Regs.AL + Byte('A'));
+end;
+{$else not go32v2}
+var
+  D : DirStr;
+begin
+  D:=GetCurDir;
+  if (Length(D)>1) and (D[2]=':') then
+    begin
+      if (D[1]>='a') and (D[1]<='z') then
+        GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
+      else
+        GetCurDrive:=D[1];
+    end
+  else
+    GetCurDrive:='C';
+end;
+{$endif not go32v2}
+
+{****************************************************************************}
+{ IsDir                             }
+{****************************************************************************}
+function IsDir(const S: String): Boolean;
+var
+  SR: SearchRec;
+  Is: boolean;
+begin
+  Is:=false;
+{$ifdef Linux}
+  Is:=(S=DirSeparator); { handle root }
+{$else}
+  Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
+  { handle root dirs }
+{$endif}
+  if Is=false then
+  begin
+    FindFirst(S, Directory, SR);
+    if DosError = 0 then
+      Is := (SR.Attr and Directory) <> 0
+    else
+      Is := False;
+   {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+  IsDir:=Is;
+end;
+
+{****************************************************************************}
+{ IsWild                           }
+{****************************************************************************}
+function IsWild(const S: String): Boolean;
+begin
+  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
+end;
+
+{****************************************************************************}
+{ IsList                           }
+{****************************************************************************}
+function IsList(const S: String): Boolean;
+begin
+  IsList := (Pos(ListSeparator,S) > 0);
+end;
+
+{****************************************************************************}
+{ MakeResources                           }
+{****************************************************************************}
+procedure MakeResources;
+var
+  Dlg : PDialog;
+  Key : String;
+  i : Word;
+begin
+  for i := 0 to 1 do
+  begin
+    case i of
+      0 : begin
+       Key := reOpenDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      1 : begin
+       Key := reSaveAsDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      2 : begin
+       Key := reEditChDirDialog;
+       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
+             hiCurrentDirectories));
+     end;
+    end;
+    if Dlg = nil then
+    begin
+       PrintStr('Error initializing dialog ' + Key);
+       Halt;
+    end
+    else begin
+      RezFile^.Put(Dlg,Key);
+      if (RezFile^.Stream^.Status <> stOk) then
+      begin
+   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
+   Halt;
+      end;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ NoWildChars                       }
+{****************************************************************************}
+function NoWildChars(S: String): String;
+const
+  WildChars : array[0..1] of Char = ('?','*');
+var
+  i : Sw_Word;
+begin
+  repeat
+    i := Pos('?',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  repeat
+    i := Pos('*',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  NoWildChars:=S;
+end;
+
+{****************************************************************************}
+{ OpenFile                          }
+{****************************************************************************}
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
+end;
+
+{****************************************************************************}
+{ OpenNewFile                       }
+{****************************************************************************}
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+begin
+  OpenNewFile := False;
+  if OpenFile(AFile,HistoryID) then
+  begin
+    if not ValidFileName(AFile) then
+      Exit;
+    if FileExists(AFile) then
+      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
+   Exit;
+    OpenNewFile := True;
+  end;
+end;
+
+{****************************************************************************}
+{ PathValid                        }
+{****************************************************************************}
+{$ifdef go32v2}
+{$define NetDrive}
+{$endif go32v2}
+{$ifdef win32}
+{$define NetDrive}
+{$endif win32}
+function PathValid (var Path: PathStr): Boolean;
+var
+  ExpPath: PathStr;
+  SR: SearchRec;
+begin
+  ExpPath := FExpand(Path);
+{$ifdef HAS_DOS_DRIVES}
+  if (Length(ExpPath) <= 3) then
+    PathValid := DriveValid(ExpPath[1])
+  else
+{$endif}
+  begin
+    { do not change '/' into '' }
+    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
+      Dec(ExpPath[0]);
+    FindFirst(ExpPath, Directory, SR);
+    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
+{$ifdef NetDrive}
+    if DosError=66 then
+      begin
+      {$ifdef fpc}
+        FindClose(SR);
+      {$endif}
+        FindFirst(ExpPath+'\*',AnyFile,SR);
+        PathValid:=(DosError = 0);
+      end;
+{$endif NetDrive}
+    {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ RegisterStdDlg                         }
+{****************************************************************************}
+procedure RegisterStdDlg;
+begin
+  RegisterType(RFileInputLine);
+  RegisterType(RFileCollection);
+  RegisterType(RFileList);
+  RegisterType(RFileInfoPane);
+  RegisterType(RFileDialog);
+  RegisterType(RDirCollection);
+  RegisterType(RDirListBox);
+  RegisterType(RSortedListBox);
+  RegisterType(RChDirDialog);
+end;
+
+{****************************************************************************}
+{ StdReplaceFile                         }
+{****************************************************************************}
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnReplace then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdReplaceFile :=
+       (MessageBox(^C + Strings^.Get(sReplaceFile),
+         @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdReplaceFile := True;
+end;
+
+{****************************************************************************}
+{ SaveAs                           }
+{****************************************************************************}
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  SaveAs := False;
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+        labels^.get(slSaveAs),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  Dlg^.HelpCtx := hcSaveAs;
+  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
+     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
+    SaveAs := True;
+end;
+
+{****************************************************************************}
+{ SelectDir                        }
+{****************************************************************************}
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+var
+  Dir: DirStr;
+  Dlg : PEditChDirDialog;
+  Rec : DirStr;
+begin
+  {$I-}
+  GetDir(0,Dir);
+  {$I+}
+  Rec := FExpand(ADir);
+  {$ifdef cdResource}
+  Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
+  {$else}
+  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
+  {$endif cdResource}
+  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
+  begin
+    SelectDir := True;
+    ADir := Rec;
+  end
+  else SelectDir := False;
+  {$I-}
+  ChDir(Dir);
+  {$I+}
+end;
+
+{****************************************************************************}
+{ ShrinkPath                         }
+{****************************************************************************}
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+var
+  Filler: string;
+  D1 : DirStr;
+  N1 : NameStr;
+  E1 : ExtStr;
+  i  : Sw_Word;
+
+begin
+  if Length(AFile) > MaxLen then
+  begin
+    FSplit(FExpand(AFile),D1,N1,E1);
+    AFile := Copy(D1,1,3) + '..' + DirSeparator;
+    i := Pred(Length(D1));
+    while (i > 0) and (D1[i] <> DirSeparator) do
+      Dec(i);
+    if (i = 0) then
+      AFile := AFile + D1
+    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
+    if AFile[Length(AFile)] <> DirSeparator then
+      AFile := AFile + DirSeparator;
+    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
+      AFile := AFile + N1 + E1
+    else
+      begin
+        Filler := '...' + DirSeparator;
+        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
+                +Filler+N1+E1;
+      end;
+  end;
+  ShrinkPath := AFile;
+end;
+
+{****************************************************************************}
+{ ValidFileName                           }
+{****************************************************************************}
+function ValidFileName(var FileName: PathStr): Boolean;
+var
+  IllegalChars: string[12];
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+begin
+{$ifdef PPC_FPC}
+{$ifdef go32v2}
+  { spaces are allowed if LFN is supported }
+  if LFNSupport then
+    IllegalChars := ';,=+<>|"[]'+DirSeparator
+  else
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$else not go32v2}
+{$ifdef win32}
+    IllegalChars := ';,=+<>|"[]'+DirSeparator;
+{$else not go32v2 and not win32 }
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif not win32}
+{$endif not go32v2}
+{$else not PPC_FPC}
+  IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif PPC_FPC}
+  ValidFileName := True;
+  FSplit(FileName, Dir, Name, Ext);
+  if not ((Dir = '') or PathValid(Dir)) or
+     Contains(Name, IllegalChars) or
+     Contains(Dir, IllegalChars) then
+    ValidFileName := False;
+end;
+
+{****************************************************************************}
+{        Unit Initialization Section                                         }
+{****************************************************************************}
+begin
+{$ifdef PPC_BP}
+  ReplaceFile := StdReplaceFile;
+  DeleteFile := StdDeleteFile;
+{$else}
+  ReplaceFile := @StdReplaceFile;
+  DeleteFile := @StdDeleteFile;
+{$endif PPC_BP}
+end.

+ 530 - 0
fvision/tabs.pas

@@ -0,0 +1,530 @@
+unit tabs;
+interface
+
+uses
+  objects,drivers,views;
+
+type
+    PTabItem = ^TTabItem;
+    TTabItem = record
+      Next : PTabItem;
+      View : PView;
+      Dis  : boolean;
+    end;
+
+    PTabDef = ^TTabDef;
+    TTabDef = record
+      Next     : PTabDef;
+      Name     : PString;
+      Items    : PTabItem;
+      DefItem  : PView;
+      ShortCut : char;
+    end;
+
+    PTab = ^TTab;
+    TTab = object(TGroup)
+      TabDefs   : PTabDef;
+      ActiveDef : integer;
+      DefCount  : word;
+      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+      function    AtTab(Index: integer): PTabDef; virtual;
+      procedure   SelectTab(Index: integer); virtual;
+      function    TabCount: integer;
+      function    Valid(Command: Word): Boolean; virtual;
+      procedure   ChangeBounds(var Bounds: TRect); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   Draw; virtual;
+      procedure   SetData(var Rec);virtual;
+      procedure   GetData(var Rec);virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      destructor  Done; virtual;
+    private
+      InDraw: boolean;
+    end;
+
+function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+
+implementation
+
+uses
+  FvCommon,dialogs;
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+  inherited Init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+  TabDefs:=ATabDef;
+  ActiveDef:=-1;
+  SelectTab(0);
+  ReDraw;
+end;
+
+function TTab.TabCount: integer;
+var i: integer;
+    P: PTabDef;
+begin
+  I:=0; P:=TabDefs;
+  while (P<>nil) do
+    begin
+      Inc(I);
+      P:=P^.Next;
+    end;
+  TabCount:=I;
+end;
+
+
+function TTab.AtTab(Index: integer): PTabDef;
+var i: integer;
+    P: PTabDef;
+begin
+  i:=0; P:=TabDefs;
+  while (I<Index) do
+    begin
+      if P=nil then RunError($AA);
+      P:=P^.Next;
+      Inc(i);
+    end;
+  AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: integer);
+var P: PTabItem;
+    V: PView;
+begin
+  if ActiveDef<>Index then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Lock;
+    { --- Update --- }
+    if TabDefs<>nil then
+       begin
+         DefCount:=1;
+         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+       end
+       else DefCount:=0;
+    if ActiveDef<>-1 then
+    begin
+      P:=AtTab(ActiveDef)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then Delete(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+    ActiveDef:=Index;
+    P:=AtTab(ActiveDef)^.Items;
+    while P<>nil do
+      begin
+        if P^.View<>nil then Insert(P^.View);
+        P:=P^.Next;
+      end;
+    V:=AtTab(ActiveDef)^.DefItem;
+    if V<>nil then V^.Select;
+    ReDraw;
+    { --- Update --- }
+    UnLock;
+    if Owner<>nil then Owner^.UnLock;
+    DrawView;
+  end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+  R: TRect;
+begin
+  if P^.Owner=nil then Exit; { it think this is a bug in TV }
+  P^.CalcBounds(R, D);
+  P^.ChangeBounds(R);
+end;
+var
+    P: PTabItem;
+    I: integer;
+begin
+  D.X := Bounds.B.X - Bounds.A.X - Size.X;
+  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+  inherited ChangeBounds(Bounds);
+  for I:=0 to TabCount-1 do
+  if I<>ActiveDef then
+    begin
+      P:=AtTab(I)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then DoCalcChange(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : integer;
+    I     : integer;
+    X     : integer;
+    Len   : byte;
+    P     : TPoint;
+    V     : PView;
+    CallOrig: boolean;
+    LastV : PView;
+    FirstV: PView;
+function FirstSelectable: PView;
+var
+    FV : PView;
+begin
+  FV := First;
+  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+        FV:=FV^.Next;
+  if FV<>nil then
+    if (FV^.Options and ofSelectable)=0 then FV:=nil;
+  FirstSelectable:=FV;
+end;
+function LastSelectable: PView;
+var
+    LV : PView;
+begin
+  LV := Last;
+  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+        LV:=LV^.Prev;
+  if LV<>nil then
+    if (LV^.Options and ofSelectable)=0 then LV:=nil;
+  LastSelectable:=LV;
+end;
+begin
+  if (Event.What and evMouseDown)<>0 then
+     begin
+       MakeLocal(Event.Where,P);
+       if P.Y<3 then
+          begin
+            Index:=-1; X:=1;
+            for i:=0 to DefCount-1 do
+                begin
+                  Len:=CStrLen(AtTab(i)^.Name^);
+                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+                  X:=X+Len+3;
+                end;
+            if Index<>-1 then
+               SelectTab(Index);
+          end;
+     end;
+  if Event.What=evKeyDown then
+     begin
+       Index:=-1;
+       case Event.KeyCode of
+            kbTab,kbShiftTab  :
+              if GetState(sfSelected) then
+                 begin
+                   if Current<>nil then
+                   begin
+                   LastV:=LastSelectable; FirstV:=FirstSelectable;
+                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+                      begin
+                        if Owner<>nil then Owner^.SelectNext(true);
+                      end else
+                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+                      begin
+                        Lock;
+                        if Owner<>nil then Owner^.SelectNext(false);
+                        UnLock;
+                      end else
+                   SelectNext(Event.KeyCode=kbShiftTab);
+                   ClearEvent(Event);
+                   end;
+                 end;
+       else
+       for I:=0 to DefCount-1 do
+           begin
+             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
+                then begin
+                       Index:=I;
+                       ClearEvent(Event);
+                       Break;
+                     end;
+           end;
+       end;
+       if Index<>-1 then
+          begin
+            Select;
+            SelectTab(Index);
+            V:=AtTab(ActiveDef)^.DefItem;
+            if V<>nil then V^.Focus;
+          end;
+     end;
+  CallOrig:=true;
+  if Event.What=evKeyDown then
+     begin
+     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+        then
+        else CallOrig:=false;
+     end;
+  if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+procedure TTab.Draw;
+var B     : TDrawBuffer;
+    i     : integer;
+    C1,C2,C3,C : word;
+    HeaderLen  : integer;
+    X,X2       : integer;
+    Name       : PString;
+    ActiveKPos : integer;
+    ActiveVPos : integer;
+    FC   : char;
+procedure SWriteBuf(X,Y,W,H: integer; var Buf);
+var i: integer;
+begin
+  if Y+H>Size.Y then H:=Size.Y-Y;
+  if X+W>Size.X then W:=Size.X-X;
+  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+                else for i:=1 to H do
+                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+  MoveChar(B,' ',C1,Size.X);
+end;
+begin
+  if InDraw then Exit;
+  InDraw:=true;
+  { - Start of TGroup.Draw - }
+{  if Buffer = nil then
+  begin
+    GetBuffer;
+  end; }
+  { - Start of TGroup.Draw - }
+
+  C1:=GetColor(1);
+  C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256;
+  C3:=GetColor(8)+GetColor({9}8)*256;
+
+  { Calculate the size of the headers }
+  HeaderLen:=0;
+  for i:=0 to DefCount-1 do
+    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3;
+  Dec(HeaderLen);
+  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+  { --- 1. sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        if i=ActiveDef
+           then begin
+                  ActiveKPos:=X-1;
+                  ActiveVPos:=X+X2+2;
+                  if GetState(sfFocused) then C:=C3 else C:=C2;
+                end
+           else C:=C2;
+        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
+        MoveChar(B[X-1],'³',C1,1);
+      end;
+  SWriteBuf(0,1,Size.X,1,B);
+
+  { --- 0. sor --- }
+  ClearBuf; MoveChar(B[0],'Ú',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        if I<ActiveDef then FC:='Ú'
+                       else FC:='¿';
+        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        MoveChar(B[X+X2],{'Â'}FC,C1,1);
+        if i=DefCount-1 then X2:=X2+1;
+        if X2>0 then
+        MoveChar(B[X],'Ä',C1,X2);
+        X:=X+X2+1;
+      end;
+  MoveChar(B[HeaderLen+1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
+  SWriteBuf(0,0,Size.X,1,B);
+
+  { --- 2. sor --- }
+  MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
+  MoveChar(B[Size.X-1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ù',C1,1);
+  if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
+                 else MoveChar(B[0],{'Ã'}'Ú',C1,1);
+  MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
+  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+  SWriteBuf(0,2,Size.X,1,B);
+
+  { --- marad‚k sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
+  SWriteBuf(0,3,Size.X,Size.Y-4,B);
+
+  { --- Size.X . sor --- }
+  MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
+  SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+  { - End of TGroup.Draw - }
+  if Buffer <> nil then
+  begin
+    Lock;
+    Redraw;
+    UnLock;
+  end;
+  if Buffer <> nil then
+    WriteBuf(0, 0, Size.X, Size.Y, Buffer^)
+  else
+    Redraw;
+  { - End of TGroup.Draw - }
+  InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+    PI : PTabItem;
+    OK : boolean;
+begin
+  OK:=true;
+  PT:=TabDefs;
+  while (PT<>nil) and (OK=true) do
+        begin
+          PI:=PT^.Items;
+          while (PI<>nil) and (OK=true) do
+                begin
+                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+                  PI:=PI^.Next;
+                end;
+          PT:=PT^.Next;
+        end;
+  Valid:=OK;
+end;
+
+
+procedure TTab.SetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.SetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.GetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.GetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and sfFocused)<>0 then DrawView;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if P<>nil then Delete(P);
+end;
+begin
+  ForEach(@DeleteViews);
+  inherited Done;
+  P:=TabDefs;
+  while P<>nil do
+        begin
+          X:=P^.Next;
+          DisposeTabDef(P);
+          P:=X;
+        end;
+end;
+
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Next:=ANext; P^.View:=AView;
+  NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+  if P<>nil then
+  begin
+    if P^.View<>nil then Dispose(P^.View, Done);
+    Dispose(P);
+  end;
+end;
+
+function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+    x: byte;
+begin
+  New(P);
+  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  x:=pos('~',AName);
+  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+                                  else P^.ShortCut:=#0;
+  P^.DefItem:=ADefItem;
+  NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+  DisposeStr(P^.Name);
+  PI:=P^.Items;
+  while PI<>nil do
+    begin
+      X:=PI^.Next;
+      DisposeTabItem(PI);
+      PI:=X;
+    end;
+  Dispose(P);
+end;
+
+end.

+ 955 - 0
fvision/test/Makefile

@@ -0,0 +1,955 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override TARGET_PROGRAMS+=tfileio testapp
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FV
+PACKAGEDIR_FV:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fv/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_FV),)
+PACKAGEDIR_FV:=$(firstword $(PACKAGEDIR_FV))
+ifeq ($(wildcard $(PACKAGEDIR_FV)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_fv
+package_fv:
+	$(MAKE) -C $(PACKAGEDIR_FV) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FV)/$(OS_TARGET)),)
+UNITDIR_FV=$(PACKAGEDIR_FV)/$(OS_TARGET)
+else
+UNITDIR_FV=$(PACKAGEDIR_FV)
+endif
+else
+PACKAGEDIR_FV=
+UNITDIR_FV:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fv/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FV),)
+UNITDIR_FV:=$(firstword $(UNITDIR_FV))
+else
+UNITDIR_FV=
+endif
+endif
+ifdef UNITDIR_FV
+override COMPILER_UNITDIR+=$(UNITDIR_FV)
+endif
+endif
+.PHONY: package_rtl package_fv
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_exes
+ifdef TARGET_PROGRAMS
+override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+endif
+fpc_exes: $(EXEFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif

+ 12 - 0
fvision/test/Makefile.fpc

@@ -0,0 +1,12 @@
+#
+#   Makefile.fpc for Free Vision Test/Examples
+#
+
+[target]
+programs=tfileio testapp
+
+[require]
+packages=fv
+
+[default]
+fpcdir=../..

+ 390 - 0
fvision/test/platform.inc

@@ -0,0 +1,390 @@
+{ $Id$ }
+{***************[ PLATFORM INCLUDE UNIT ]******************}
+{                                                          }
+{    System independent INCLUDE file to sort PLATFORMS     }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                     }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{        LINUX    - FPC 0.9912+             (32 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     02 Jul 97  Bazsi  Initial implementation        }
+{  0.2     28 Aug 97  LdB    Fixed OS2 platform sort       }
+{  0.3     29 Aug 97  LdB    Added assembler type changes  }
+{  0.4     29 Aug 97  LdB    OS_DOS removed from WINDOWS   }
+{  0.5     23 Oct 97  LdB    Delphi & speed compilers      }
+{  0.6     05 May 98  LdB    Virtual Pascal 2.0 added      }
+{  0.7     19 May 98  LdB    Delphi 2/3 definitions added  }
+{  0.8     06 Aug 98  CEC    FPC only support fixed WIN32  }
+{  0.9     10 Aug 98  LdB    BP_VMTLink def/Undef added    }
+{  1.0     27 Aug 98  LdB    Atari, Mac etc not undef dos  }
+{  1.1     25 Oct 98  PfV    Delphi 4 definitions added    }
+{  1.2     06 Jun 99  LdB    Sybil 2.0 support added       }
+{  1.3     13 Jun 99  LdB    Sybil 2.0 undef BP_VMT link   }
+{  1.31    03 Nov 99  LdB    FPC windows defines WIN32     }
+{  1.32    04 Nov 99  LdB    Delphi 5 definitions added    }
+{  1.33    16 Oct 00  LdB    WIN32/WIN16 defines added     }
+{**********************************************************}
+
+{ ****************************************************************************
+
+   This include file defines some conditional defines to allow us to select
+   the compiler/platform/target in a consequent way.
+
+    OS_XXXX         The operating system used (XXXX may be one of:
+                       DOS, OS2, Linux, Windows, Go32)
+    PPC_XXXX        The compiler used: BP, FPK, Virtual, Speed
+    BIT_XX          The number of bits of the target platform: 16 or 32
+    PROC_XXXX       The mode of the target processor (Real or Protected)
+                    This shouldn't be used, except for i386 specific parts.
+    ASM_XXXX        This is the assembler type: BP, ISO-ANSI, FPK
+
+ ****************************************************************************
+
+    This is how the IFDEF and UNDEF statements below should translate.
+
+
+ PLATFORM  SYSTEM    COMPILER  COMP ID      CPU MODE        BITS    ASSEMBLER
+ --------  ------    --------  -------      --------        ----    ---------
+
+ DOS      OS_DOS      BP/TP7   PPC_BP       PROC_Real       BIT_16  ASM_BP
+
+ DPMI     OS_DOS      BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ WINDOWS  OS_WINDOWS  BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      DELPHI   PPC_DELPHI   PROC_Protected  BIT_16  ASM_BP
+                      DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_16  ASM_BP
+
+ WIN95/NT OS_WINDOWS  DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI3  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI4  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI5  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT 32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ OS2      OS_OS2      BPOS2    PPC_BPOS2    PROC_Protected  BIT_16  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT_32  ASM_BP
+                      SPEED    PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ ****************************************************************************}
+{****************************************************************************
+
+FOR ALL COMPILERS BP_VMTLink defined but FPC and Delphi3/Delphi4 undefine it
+
+ ****************************************************************************}
+{****************************************************************************
+
+FOR FPC THESE ARE THE TRANSLATIONS
+
+  PLATFORM  SYSTEM    COMPILER  HANDLE SIZE      ASM          CPU
+ --------  ------    --------  -----------      ----         ---
+
+ DOS      OS_DOS,OS_GO32 FPC     32-bit         AT&T         CPU86
+
+ WIN32    OS_WINDOWS   FPC     32-bit           AT&T         ----
+
+ LINUX    OS_LINUX     FPC     32-bit           AT&T         ----
+
+ OS2      OS_OS2       FPC     ?????            AT&T         CPU86
+
+ ATARI    OS_ATARI     FPC     32-bit           Internal     CPU68
+
+ MACOS    OS_MAC       FPC     ?????            Internal     CPU68
+
+ AMIGA    OS_AMIGA     FPC     32-bit           Internal     CPU68
+
+ ****************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  Initial assume BORLAND 16 BIT DOS COMPILER - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$DEFINE OS_DOS}
+{$DEFINE PROC_Real}
+{$DEFINE BIT_16}
+{$DEFINE PPC_BP}
+{$DEFINE ASM_BP}
+{$DEFINE BP_VMTLink}
+{$DEFINE CPU86}
+
+{---------------------------------------------------------------------------}
+{  BORLAND 16 BIT DPMI changes protected mode - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$IFDEF DPMI}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF FPC}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_FPC}
+  {$UNDEF ASM_BP}
+  {$DEFINE ASM_FPC}
+  {$UNDEF BP_VMTLink}
+  {$DEFINE Use_API}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{$IFDEF NoAPI}
+{$UNDEF Use_API}
+{$UNDEF NO_WINDOW}
+{$ENDIF UseAPI}
+
+
+{---------------------------------------------------------------------------}
+{  FPC LINUX COMPILER changes operating system - Updated 27Aug98 LdB        }
+{  Note: Other linux compilers would need to change other details           }
+{---------------------------------------------------------------------------}
+{$IFDEF LINUX}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_LINUX}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC GO32V2 COMPILER changes operating system - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF GO32V2}
+  {$DEFINE OS_GO32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
+{---------------------------------------------------------------------------}
+{$IFDEF WIN32}
+  {$IFNDEF WINDOWS}
+    {$DEFINE WINDOWS}
+  {$ENDIF}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WINDOWS COMPILERS change op system and proc mode - Updated 03Nov99 LdB   }
+{---------------------------------------------------------------------------}
+{$IFDEF WINDOWS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_WINDOWS}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$IFDEF FPC}
+    {$DEFINE WIN32}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI1 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER80}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI2 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER90}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI2}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI3 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER100}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI4 COMPILER changes compiler type - Updated 25Oct98 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER120}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI5 COMPILER changes compiler type - Updated 04Nov99 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER130}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$DEFINE PPC_DELPHI5}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  OS2 COMPILERS change compiler type and mode - Updated 27Aug98 LdB        }
+{  Note: Assumes BPOS2 16BIT OS2 patch except for FPC which undefines this  }
+{---------------------------------------------------------------------------}
+{$IFDEF OS2}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_OS2}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_BPOS2}
+  {$IFDEF FPC}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  VIRTUAL PASCAL changes compiler type/32 bit - Updated 27Aug98 LdB        }
+{  Note: VP2 can compile win 32 code so changes op system as needed         }
+{---------------------------------------------------------------------------}
+{$IFDEF VirtualPascal}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$IFDEF PPC_BPOS2}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+  {$DEFINE PPC_VIRTUAL}
+  {$IFDEF WIN32}
+    {$UNDEF PPC_BP}
+    {$UNDEF OS_OS2}
+    {$DEFINE OS_WINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  SPEED COMPILER changes compiler type/32 bit  - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF Speed}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BPOS2}
+  {$DEFINE PPC_SPEED}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC AMIGA COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF AMIGA}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_AMIGA}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC ATARI COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF ATARI}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_ATARI}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC MAC COMPILER changes op system and CPU type - Updated 27Aug98 LdB    }
+{---------------------------------------------------------------------------}
+{$IFDEF MACOS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_MAC}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF OS_DOS}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB                }
+{---------------------------------------------------------------------------}
+{$IFDEF OS_WINDOWS}                                   { WINDOWS SYSTEM }
+  {$IFDEF BIT_16}
+    {$DEFINE WIN16}                                   { 16 BIT WINDOWS }
+  {$ENDIF}
+  {$IFDEF BIT_32}
+    {$DEFINE WIN32}                                   { 32 BIT WINDOWS }
+  {$ENDIF}
+{$ENDIF}
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.5  2001/05/03 22:32:52  pierre
+  new bunch of changes, displays something for dos at least
+
+ Revision 1.4  2001/04/10 21:57:56  pierre
+  + first adds for Use_API define
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}
+

+ 376 - 0
fvision/test/testapp.pas

@@ -0,0 +1,376 @@
+{ $Id$ }
+PROGRAM TestApp;
+
+{&PMTYPE PM}                                          { FULL GUI MODE }
+
+{ ******************************* REMARK ****************************** }
+{  This is a basic test program to test the app framework. In use will  }
+{  be menus, statuslines, windows, dialogs, scrollbars, statictext,     }
+{  radiobuttons, check boxes, list boxes and input lines.               }
+{                                                                       }
+{  Working compilers:                                                   }
+{     WINDOWS BPW, VP2, Delphi1, FPC WIN (0.9912)                       }
+{     DOS has draw bugs but works for BP and FPC DOS (GO32V2)           }
+{     OS2 dows not work still some PM bits to do                        }
+{                                                                       }
+{  Not working:                                                         }
+{     Delphi3, Delphi5 (sus 4) will compile but Tgroup.ForEach etc U/S. }
+{     Sybil2 Win32 should work but to big for demo mode so unsure!      }
+{                                                                       }
+{  Special things to try out:                                           }
+{    Check out the standard windows minimize etc icons.                 }
+{                                                                       }
+{                                                                       }
+{  Comments:                                                            }
+{    There is alot that may seem more complex than it needs to but      }
+{    I have much more elaborate objects operating such as bitmaps,      }
+{    bitmap buttons, percentage bars etc and they need these hooks.     }
+{    Basically the intention is to be able to port existing TV apps     }
+{    as a start point and then start to optimize and use the new        }
+{    GUI specific objects. I will try to get some documentation         }
+{    done on how everything works because some things are hard to       }
+{    follow in windows.                                                 }
+{ ****************************** END REMARK *** Leon de Boer, 06Nov99 * }
+
+{$I Platform.inc}
+  USES
+     {$IFDEF OS_OS2} Os2Def, os2PmApi,  {$ENDIF}
+     Objects, Drivers, Views, Menus, Dialogs, App,             { Standard GFV units }
+     {$ifdef TEST}
+     AsciiTab,
+     {$endif TEST}
+     {$ifdef DEBUG}
+     Gfvgraph,
+     {$endif DEBUG}
+     Gadgets;
+
+
+CONST cmAppToolbar = 1000;
+      cmWindow1    = 1001;
+      cmWindow2    = 1002;
+      cmWindow3    = 1003;
+      cmAscii      = 1010;
+      cmCloseWindow1    = 1101;
+      cmCloseWindow2    = 1102;
+      cmCloseWindow3    = 1103;
+
+{---------------------------------------------------------------------------}
+{          TTestAppp OBJECT - STANDARD APPLICATION WITH MENU                }
+{---------------------------------------------------------------------------}
+TYPE
+   PTVDemo = ^TTVDemo;
+   TTVDemo = OBJECT (TApplication)
+        Clock: PClockView;
+        Heap: PHeapView;
+        P1,P2,P3 : PGroup;
+     {$ifdef TEST}
+        ASCIIChart : PAsciiChart;
+     {$endif TEST}
+      CONSTRUCTOR Init;
+      PROCEDURE Idle; Virtual;
+      PROCEDURE HandleEvent(var Event : TEvent);virtual;
+      PROCEDURE InitMenuBar; Virtual;
+      PROCEDURE InitDeskTop; Virtual;
+      PROCEDURE Window1;
+      PROCEDURE Window2;
+      PROCEDURE Window3;
+      PROCEDURE AsciiWindow;
+      PROCEDURE CloseWindow(var P : PGroup);
+    End;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                           TTvDemo OBJECT METHODS                          }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+CONSTRUCTOR TTvDemo.Init;
+VAR R: TRect;
+BEGIN
+  Inherited Init;
+  { Initialize demo gadgets }
+
+  GetExtent(R);
+  R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
+  Clock := New(PClockView, Init(R));
+  Insert(Clock);
+
+  GetExtent(R);
+  Dec(R.B.X);
+  R.A.X := R.B.X - 12; R.A.Y := R.B.Y - 1;
+  Heap := New(PHeapView, Init(R));
+  Insert(Heap);
+END;
+
+procedure TTVDemo.Idle;
+
+function IsTileable(P: PView): Boolean; far;
+begin
+  IsTileable := (P^.Options and ofTileable <> 0) and
+    (P^.State and sfVisible <> 0);
+end;
+
+{$ifdef DEBUG}
+Var
+   WasSet : boolean;
+{$endif DEBUG}
+begin
+  inherited Idle;
+{$ifdef DEBUG}
+   if WriteDebugInfo then
+     begin
+      WasSet:=true;
+      WriteDebugInfo:=false;
+     end
+   else
+      WasSet:=false;
+   if WriteDebugInfo then
+{$endif DEBUG}
+  Clock^.Update;
+  Heap^.Update;
+{$ifdef DEBUG}
+   if WasSet then
+     WriteDebugInfo:=true;
+{$endif DEBUG}
+  if Desktop^.FirstThat(@IsTileable) <> nil then
+    EnableCommands([cmTile, cmCascade])
+  else
+    DisableCommands([cmTile, cmCascade]);
+end;
+
+PROCEDURE TTVDemo.HandleEvent(var Event : TEvent);
+BEGIN
+   Inherited HandleEvent(Event);                      { Call ancestor }
+   If (Event.What = evCommand) Then Begin
+     Case Event.Command Of
+       cmWindow1 : Window1;
+       cmWindow2 : Window2;
+       cmWindow3 : Window3;
+       cmAscii   : AsciiWindow;
+       cmCloseWindow1 : CloseWindow(P1);
+       cmCloseWindow2 : CloseWindow(P2);
+       cmCloseWindow3 : CloseWindow(P3);
+       Else Exit;                                     { Unhandled exit }
+     End;
+   End;
+   ClearEvent(Event);
+END;
+
+{--TTvDemo------------------------------------------------------------------}
+{  InitMenuBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Nov99 LdB       }
+{---------------------------------------------------------------------------}
+PROCEDURE TTVDemo.InitMenuBar;
+VAR R: TRect;
+BEGIN
+   GetExtent(R);                                      { Get view extents }
+   R.B.Y := R.A.Y + 1;                                { One line high  }
+   MenuBar := New(PMenuBar, Init(R, NewMenu(
+    NewSubMenu('~F~ile', 0, NewMenu(
+      StdFileMenuItems(Nil)),                         { Standard file menu }
+    NewSubMenu('~E~dit', 0, NewMenu(
+      StdEditMenuItems(Nil)),                         { Standard edit menu }
+    NewSubMenu('~T~est', 0, NewMenu(
+      NewItem('Ascii Chart','',kbNoKey,cmAscii,hcNoContext,
+      NewItem('Window 1','',kbNoKey,cmWindow1,hcNoContext,
+      NewItem('Window 2','',kbNoKey,cmWindow2,hcNoContext,
+      NewItem('Window 3','',kbNoKey,cmWindow3,hcNoContext,
+      NewItem('Close Window 1','',kbNoKey,cmCloseWindow1,hcNoContext,
+      NewItem('Close Window 2','',kbNoKey,cmCloseWindow2,hcNoContext,
+      NewItem('Close Window 3','',kbNoKey,cmCloseWindow3,hcNoContext,
+      Nil)))))))),
+    NewSubMenu('~W~indow', 0, NewMenu(
+      StdWindowMenuItems(Nil)), Nil)))))));            { Standard window  menu }
+END;
+
+{--TTvDemo------------------------------------------------------------------}
+{  InitDesktop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Nov99 LdB       }
+{---------------------------------------------------------------------------}
+PROCEDURE TTvDemo.InitDesktop;
+VAR R: TRect; {ToolBar: PToolBar;}
+BEGIN
+   GetExtent(R);                                      { Get app extents }
+   Inc(R.A.Y);               { Adjust top down }
+   Dec(R.B.Y);            { Adjust bottom up }
+(*   ToolBar := New(PToolBar, Init(R.A.X*FontWidth,
+     R.A.Y*FontHeight, (R.B.X-R.A.X)*FontWidth, 20,
+     cmAppToolBar));
+   If (ToolBar <> Nil) Then Begin
+     R.A.X := R.A.X*FontWidth;
+     R.A.Y := R.A.Y*FontHeight + 25;
+     R.B.X := -R.B.X*FontWidth;
+     R.B.Y := -R.B.Y*Fontheight;
+     ToolBar^.AddTool(NewToolEntry(cmQuit, True,
+       '20X20EXIT', 'ToolBar.Res'));
+     ToolBar^.AddTool(NewToolEntry(cmNew, True,
+       '20X20NEW', 'ToolBar.Res'));
+     ToolBar^.AddTool(NewToolEntry(cmOpen, True,
+       '20X20LOAD', 'ToolBar.Res'));
+     Insert(ToolBar);
+   End;*)
+   Desktop := New(PDeskTop, Init(R));
+END;
+
+PROCEDURE TTvDemo.Window1;
+VAR R: TRect; P: PGroup;
+BEGIN
+   { Create a basic window with static text and radio }
+   { buttons. The buttons should be orange and white  }
+   R.Assign(5, 1, 35, 16);                            { Assign area }
+   P := New(PWindow, Init(R, 'TEST WINDOW 1', 1));    { Create a window }
+   If (P <> Nil) Then Begin                           { Window valid }
+     R.Assign(5, 5, 20, 6);                           { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 30)));
+     R.Assign(5, 8, 20, 9);                           { Assign area }
+     P^.Insert(New(PRadioButtons, Init(R,
+       NewSItem('Test',
+       NewSITem('Item 2', Nil)))));                   { Red radio button }
+     R.Assign(5, 10, 28, 11);                         { Assign area }
+     P^.Insert(New(PStaticText, Init(R,
+       'SOME STATIC TEXT')));                         { Insert static text }
+   End;
+   Desktop^.Insert(P);                                { Insert into desktop }
+   P1:=P;
+END;
+
+PROCEDURE TTvDemo.AsciiWindow;
+begin
+{$ifdef TEST}
+  if ASCIIChart=nil then
+    begin
+      New(ASCIIChart, Init);
+      Desktop^.Insert(ASCIIChart);
+    end
+  else
+    ASCIIChart^.Focus;
+{$endif TEST}
+end;
+
+
+PROCEDURE TTvDemo.CloseWindow(var P : PGroup);
+BEGIN
+  If Assigned(P) then
+    BEGIN
+      Desktop^.Delete(P);
+      Dispose(P,Done);
+      P:=Nil;
+    END;
+END;
+PROCEDURE TTvDemo.Window2;
+VAR R: TRect; P: PGroup;
+BEGIN
+   { Create a basic window with check boxes. The  }
+   { check boxes should be orange and white       }
+   R.Assign(15, 3, 45, 18);                           { Assign area }
+   P := New(PWindow, Init(R, 'TEST WINDOW 2', 2));    { Create window 2 }
+   If (P <> Nil) Then Begin                           { Window valid }
+     R.Assign(5, 5, 20, 7);                           { Assign area }
+     P^.Insert(New(PCheckBoxes, Init(R,
+       NewSItem('Test check',
+       NewSITem('Item 2', Nil)))));                   { Create check box }
+   End;
+   Desktop^.Insert(P);                                { Insert into desktop }
+   P2:=P;
+END;
+
+PROCEDURE TTvDemo.Window3;
+VAR R: TRect; P: PGroup; B: PScrollBar;
+    List: PStrCollection; Lb: PListBox;
+BEGIN
+   { Create a basic dialog box. In it are buttons,  }
+   { list boxes, scrollbars, inputlines, checkboxes }
+   R.Assign(32, 2, 77, 18);                           { Assign screen area }
+   P := New(PDialog, Init(R, 'TEST DIALOG'));         { Create dialog }
+   If (P <> Nil) Then Begin                           { Dialog valid }
+     R.Assign(5, 5, 20, 7);                          { Allocate area }
+     P^.Insert(New(PCheckBoxes, Init(R,
+       NewSItem('Test',
+       NewSITem('Item 2', Nil)))));                   { Insert check box }
+     R.Assign(5, 2, 20, 3);                           { Assign area }
+     B := New(PScrollBar, Init(R));                   { Insert scroll bar }
+     If (B <> Nil) Then Begin                         { Scrollbar valid }
+       B^.SetRange(0, 100);                           { Set scrollbar range }
+       B^.SetValue(50);                               { Set position }
+       P^.Insert(B);                                  { Insert scrollbar }
+     End;
+     R.Assign(5, 10, 20, 11);                         { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
+     R.Assign(5, 13, 20, 14);                         { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
+     R.Assign(40, 8, 41, 14);                         { Assign area }
+     B := New(PScrollBar, Init(R));                   { Create scrollbar }
+     P^.Insert(B);                                    { Insert scrollbar }
+     R.Assign(25, 8, 40, 14);                         { Assign area }
+     Lb := New(PListBox, Init(R, 1, B));              { Create listbox }
+     P^.Insert(Lb);                                   { Insert listbox }
+     List := New(PStrCollection, Init(10, 5));        { Create string list }
+     List^.AtInsert(0, NewStr('Zebra'));              { Insert text }
+     List^.AtInsert(1, NewStr('Apple'));              { Insert text }
+     List^.AtInsert(2, NewStr('Third'));              { Insert text }
+     List^.AtInsert(3, NewStr('Peach'));              { Insert text }
+     List^.AtInsert(4, NewStr('Rabbit'));             { Insert text }
+     List^.AtInsert(5, NewStr('Item six'));           { Insert text }
+     List^.AtInsert(6, NewStr('Jaguar'));             { Insert text }
+     List^.AtInsert(7, NewStr('Melon'));              { Insert text }
+     List^.AtInsert(8, NewStr('Ninth'));              { Insert text }
+     List^.AtInsert(9, NewStr('Last item'));          { Insert text }
+     Lb^.Newlist(List);                               { Give list to listbox }
+     R.Assign(30, 2, 40, 4);                          { Assign area }
+     P^.Insert(New(PButton, Init(R, '~O~k', 100, bfGrabFocus)));{ Create okay button }
+     R.Assign(30, 15, 40, 17);                        { Assign area }
+     Desktop^.Insert(P);                              { Insert dialog }
+     P3:=P;
+   End;
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                             MAIN PROGRAM START                            }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+VAR I: Integer; R: TRect; P: PGroup; MyApp: TTvDemo;
+    {$IFDEF OS_OS2} Message: QMSg; Event: TEvent; {$ENDIF}
+BEGIN
+   (*SystemPalette := CreateRGBPalette(256);            { Create palette }
+   For I := 0 To 15 Do Begin
+     GetSystemRGBEntry(I, RGB);                       { Get palette entry }
+     AddToRGBPalette(RGB, SystemPalette);             { Add entry to palette }
+   End;*)
+
+   MyApp.Init;                                        { Initialize app }
+
+
+   MyApp.Run;                                         { Run the app }
+   {$IFDEF OS_OS2}
+   while (MyApp.EndState = 0)
+   AND WinGetMsg(Anchor, Message, 0, 0, 0) Do Begin
+       WinDispatchMsg(Anchor, Message);
+       NextQueuedEvent(Event);
+       If (event.What <>  evNothing)
+         Then MyApp.handleEvent(Event);
+   End;
+   {$ENDIF}
+   MyApp.Done;                                        { Dispose of app }
+
+   {DisposeRGBPalette(SystemPalette);}
+END.
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.6  2001/05/31 21:40:10  pierre
+  * some debug stuff changed
+
+ Revision 1.5  2001/05/04 15:43:46  pierre
+  * several more fixes
+
+ Revision 1.4  2001/05/04 10:46:02  pierre
+  * various fixes  for win32 api mode
+
+ Revision 1.3  2001/05/04 08:42:55  pierre
+  * some corrections for linux
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}

+ 2 - 2
fvision/test/tfileio.pas

@@ -1,10 +1,10 @@
 USES
 USES
-  Common,FileIO;
+  FVCommon,FileIO;
 
 
 VAR
 VAR
   Handle : THandle;
   Handle : THandle;
   buf    : ARRAY[0..255] OF CHAR;
   buf    : ARRAY[0..255] OF CHAR;
-  n 	 : Longint;
+  n      : Longint;
 BEGIN
 BEGIN
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   writeln('FileOpen: ',Handle);
   writeln('FileOpen: ',Handle);

+ 6 - 2
fvision/validate.pas

@@ -74,7 +74,7 @@ UNIT Validate;
 {$V-} { Turn off strict VAR strings }
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 {====================================================================}
 
 
-USES Common, Objects;                                 { GFV standard units }
+USES FVCommon, Objects;                                 { GFV standard units }
 
 
 {***************************************************************************}
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
 {                              PUBLIC CONSTANTS                             }
@@ -1058,7 +1058,11 @@ END.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.4  2001-05-03 22:32:52  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 22:32:52  pierre
   new bunch of changes, displays something for dos at least
   new bunch of changes, displays something for dos at least
 
 
  Revision 1.3  2001/04/10 21:29:55  pierre
  Revision 1.3  2001/04/10 21:29:55  pierre

File diff suppressed because it is too large
+ 164 - 174
fvision/views.pas


Some files were not shown because too many files changed in this diff