moved files

install/demo/graph/Makefile

@@ -0,0 +1,1222 @@
+#
+# Makefile generated by fpcmake v0.99.13 [2000/02/23]
+#
+
+defaultrule: both
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+# We need only / in the path
+override PATH:=$(subst \,/,$(PATH))
+
+# Search for PWD and determine also if we are under linux
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+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
+inlinux=1
+endif
+else
+PWD:=$(firstword $(PWD))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+# Detect OS/2 - OS/2 has OS2_SHELL defined
+ifndef inlinux
+ifndef inWinNT
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+endif
+
+# The extension of executables
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# The path which is searched separated by spaces
+ifdef inlinux
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+
+# Base dir
+ifdef PWD
+BASEDIR:=$(shell $(PWD))
+else
+BASEDIR=.
+endif
+
+#####################################################################
+# FPC version/target Detection
+#####################################################################
+
+# What compiler to use ?
+ifndef FPC
+# Compatibility with old makefiles
+ifdef PP
+FPC=$(PP)
+else
+ifdef inOS2
+FPC=ppos2
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(EXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(EXEEXT)
+
+# Target OS
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+
+# Source OS
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+
+# Target CPU
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+
+# Source CPU
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+
+# FPC version
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+
+#####################################################################
+# FPCDIR Setting
+#####################################################################
+
+# Test FPCDIR to look if the RTL dir exists
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+else
+override FPCDIR=wrong
+endif
+
+# Default FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+
+# Detect FPCDIR
+ifeq ($(FPCDIR),wrong)
+ifdef inlinux
+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 $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+endif
+
+ifndef PACKAGESDIR
+PACKAGESDIR=$(FPCDIR)/packages
+endif
+ifndef TOOLKITSDIR
+TOOLKITSDIR=
+endif
+ifndef COMPONENTSDIR
+COMPONENTSDIR=
+endif
+
+# Create units dir
+ifneq ($(FPCDIR),.)
+UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
+endif
+
+#####################################################################
+# User Settings
+#####################################################################
+
+
+# Targets
+
+override UNITOBJECTS+=gameunit
+override EXEOBJECTS+=fpctris
+ifeq ($(OS_TARGET),linux)
+override EXEOBJECTS+=mandel samegame quad maze gravwars
+endif
+ifeq ($(OS_TARGET),go32v2)
+override EXEOBJECTS+=mandel samegame quad maze gravwars
+endif
+ifeq ($(OS_TARGET),win32)
+override EXEOBJECTS+=mandel samegame quad maze gravwars
+endif
+
+# Clean
+
+
+# Install
+
+PACKAGENAME=demo
+ZIPTARGET=install
+
+# Defaults
+
+
+# Directories
+
+ifndef TARGETDIR
+TARGETDIR=.
+endif
+
+# Packages
+
+override PACKAGES+=rtl api
+
+# Libraries
+
+
+# Info
+
+INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
+
+#####################################################################
+# Post Settings
+#####################################################################
+
+ifdef GRAPHICS
+override FPCOPT+=-dUSEGRAPHICS
+endif
+
+#####################################################################
+# Shell tools
+#####################################################################
+
+# echo
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=echo
+ECHOE:=echo
+else
+ECHO:=$(firstword $(ECHO))
+ECHOE=$(ECHO) -E
+endif
+else
+ECHO:=$(firstword $(ECHO))
+ECHOE=$(ECHO) -E
+endif
+endif
+
+# To copy pograms
+ifndef COPY
+COPY:=cp -fp
+endif
+
+# Copy a whole tree
+ifndef COPYTREE
+COPYTREE:=cp -rfp
+endif
+
+# To move pograms
+ifndef MOVE
+MOVE:=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+DEL:=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+DELTREE:=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+INSTALL:=install -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+INSTALLEXE:=install -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+MKDIR:=install -m 755 -d
+else
+MKDIR:=ginstall -m 755 -d
+endif
+endif
+
+export ECHO ECHOE COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used
+ifndef LD
+LD=ld
+endif
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+ifdef inOS2
+PPAS=ppas.cmd
+else
+PPAS=ppas.bat
+endif
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# ppumove
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+
+# ppufiles
+ifndef PPUFILES
+PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUFILES),)
+PPUFILES=
+else
+PPUFILES:=$(firstword $(PPUFILES))
+endif
+endif
+export PPUFILES
+
+# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
+# upx uses that one itself (PFV)
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+
+# ZipProg, you can't use Zip as the var name (PFV)
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+
+ZIPOPT=-9
+ZIPEXT=.zip
+
+# Tar
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+LOADEREXT=.as
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+RSTEXT=.rst
+FPCMADE=fpcmade
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+FPCMADE=fpcmade.v1
+endif
+
+# Go32v2
+ifeq ($(OS_TARGET),go32v2)
+FPCMADE=fpcmade.dos
+endif
+
+# Linux
+ifeq ($(OS_TARGET),linux)
+FPCMADE=fpcmade.lnx
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine which .pas extension is used
+ifndef PASEXT
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+endif
+
+
+# Check if the dirs really exists, else turn it off
+ifeq ($(wildcard $(UNITSDIR)),)
+UNITSDIR=
+endif
+ifeq ($(wildcard $(TOOLKITSDIR)),)
+TOOLKITSDIR=
+endif
+ifeq ($(wildcard $(PACKAGESDIR)),)
+PACKAGESDIR=
+endif
+ifeq ($(wildcard $(COMPONENTSDIR)),)
+COMPONENTSDIR=
+endif
+
+
+# PACKAGESDIR packages
+
+PACKAGERTL=1
+PACKAGEAPI=1
+
+ifdef PACKAGERTL
+ifneq ($(wildcard $(FPCDIR)/rtl),)
+ifneq ($(wildcard $(FPCDIR)/rtl/$(OS_TARGET)),)
+PACKAGEDIR_RTL=$(FPCDIR)/rtl/$(OS_TARGET)
+else
+PACKAGEDIR_RTL=$(FPCDIR)/rtl
+endif
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+else
+PACKAGEDIR_RTL=
+ifneq ($(wildcard $(UNITSDIR)/rtl),)
+ifneq ($(wildcard $(UNITSDIR)/rtl/$(OS_TARGET)),)
+UNITDIR_RTL=$(UNITSDIR)/rtl/$(OS_TARGET)
+else
+UNITDIR_RTL=$(UNITSDIR)/rtl
+endif
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override NEEDUNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef PACKAGEAPI
+ifneq ($(wildcard $(FPCDIR)/api),)
+ifneq ($(wildcard $(FPCDIR)/api/$(OS_TARGET)),)
+PACKAGEDIR_API=$(FPCDIR)/api/$(OS_TARGET)
+else
+PACKAGEDIR_API=$(FPCDIR)/api
+endif
+ifeq ($(wildcard $(PACKAGEDIR_API)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_api
+package_api:
+	$(MAKE) -C $(PACKAGEDIR_API) all
+endif
+UNITDIR_API=$(PACKAGEDIR_API)
+else
+PACKAGEDIR_API=
+ifneq ($(wildcard $(UNITSDIR)/api),)
+ifneq ($(wildcard $(UNITSDIR)/api/$(OS_TARGET)),)
+UNITDIR_API=$(UNITSDIR)/api/$(OS_TARGET)
+else
+UNITDIR_API=$(UNITSDIR)/api
+endif
+else
+UNITDIR_API=
+endif
+endif
+ifdef UNITDIR_API
+override NEEDUNITDIR+=$(UNITDIR_API)
+endif
+endif
+
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+PREFIXINSTALLDIR=/usr
+else
+PREFIXINSTALLDIR=/pp
+endif
+endif
+export PREFIXINSTALLDIR
+
+# Where to place the resulting zip files
+ifndef DESTZIPDIR
+DESTZIPDIR:=$(BASEDIR)
+endif
+export DESTZIPDIR
+
+#####################################################################
+# Install Directories
+#####################################################################
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+UNITINSTALLDIR=$(BASEINSTALLDIR)/units/$(OS_TARGET)
+ifdef UNITSUBDIR
+UNITINSTALLDIR:=$(UNITINSTALLDIR)/$(UNITSUBDIR)
+endif
+endif
+
+# Where to install shared libraries
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+LIBINSTALLDIR=$(UNITINSTALLDIR)
+endif
+endif
+
+# Where the source files will be stored
+ifndef SOURCEINSTALLDIR
+ifdef inlinux
+SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
+else
+SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
+endif
+ifdef SOURCESUBDIR
+SOURCEINSTALLDIR:=$(SOURCEINSTALLDIR)/$(SOURCESUBDIR)
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc-$(FPC_VERSION)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+# Where the some extra (data)files will be stored
+ifndef DATAINSTALLDIR
+DATAINSTALLDIR=$(BASEINSTALLDIR)
+endif
+
+#####################################################################
+# Redirection
+#####################################################################
+
+ifndef REDIRFILE
+REDIRFILE=log
+endif
+
+ifdef REDIR
+ifndef inlinux
+override FPC=redir -eo $(FPC)
+endif
+# set the verbosity to max
+override FPCOPT+=-va
+override REDIR:= >> $(REDIRFILE)
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add FPC_CPU define
+override FPCOPTDEF:=-d$(CPU_TARGET)
+
+# Load commandline OPT and add target and unit dir to be sure
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+
+ifdef NEEDUNITDIR
+override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
+endif
+
+ifdef UNITSDIR
+override FPCOPT+=-Fu$(UNITSDIR)
+endif
+
+# Target dirs
+ifdef TARGETDIR
+override FPCOPT+=-FE$(TARGETDIR)
+endif
+
+# Smartlinking
+ifdef LINKSMART
+override FPCOPT+=-CX
+endif
+
+# Smartlinking
+ifdef CREATESMART
+override FPCOPT+=-XX
+endif
+
+# Debug
+ifdef DEBUG
+override FPCOPT+=-g -dDEBUG
+endif
+
+# Release mode (strip, optimize and don't load ppc386.cfg)
+# 0.99.12b has a bug in the optimizer so don't use it by default
+ifdef RELEASE
+ifeq ($(FPC_VERSION),0.99.12)
+override FPCOPT+=-Xs -OGp3 -n
+else
+override FPCOPT+=-Xs -OG2p3 -n
+endif
+endif
+
+# Strip
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+
+# Optimizer
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+
+# Add commandline options
+ifdef OPT
+override FPCOPT+=$(OPT)
+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
+
+# Add defines from FPCOPTDEF to FPCOPT
+ifdef FPCOPTDEF
+override FPCOPT+=$(FPCOPTDEF)
+endif
+
+# Error file ?
+ifdef ERRORFILE
+override FPCOPT+=-Fr$(ERRORFILE)
+endif
+
+# Was a config file specified ?
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+
+# For win32 the options are passed using the environment FPCEXTCMD
+ifeq ($(OS_SOURCE),win32)
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+
+# Compiler commandline
+override COMPILER:=$(FPC) $(FPCOPT)
+
+# also call ppas if with command option -s
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+EXECPPAS:=@$(PPAS)
+endif
+
+#####################################################################
+# Standard rules
+#####################################################################
+
+all: fpc_all
+
+debug: fpc_debug
+
+smart: fpc_smart
+
+shared: fpc_shared
+
+showinstall: fpc_showinstall
+
+install: fpc_install
+
+sourceinstall: fpc_sourceinstall
+
+zipinstall: fpc_zipinstall
+
+zipsourceinstall: fpc_zipsourceinstall
+
+distclean: fpc_distclean
+
+cleanall: fpc_cleanall
+
+info: fpc_info
+
+.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipsourceinstall distclean cleanall info
+
+#####################################################################
+# Units
+#####################################################################
+
+.PHONY: fpc_units
+
+override ALLTARGET+=fpc_units
+
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+
+fpc_units: $(UNITPPUFILES)
+
+#####################################################################
+# Exes
+#####################################################################
+
+.PHONY: fpc_exes
+
+override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
+
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+
+fpc_exes: $(EXEFILES)
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+.PHONY: fpc_packages fpc_all fpc_debug
+
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHO) Compiled > $(FPCMADE)
+
+fpc_packages: $(COMPILEPACKAGES)
+
+fpc_all: fpc_packages $(FPCMADE)
+
+fpc_debug:
+	$(MAKE) all DEBUG=1
+
+# General compile rules, available for both possible PASEXT
+
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+
+%$(PPUEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(PPUEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(EXEEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(EXEEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+#####################################################################
+# Library
+#####################################################################
+
+.PHONY: fpc_smart fpc_shared
+
+# Default sharedlib units are all unit objects
+ifndef SHAREDLIBUNITOBJECTS
+SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
+endif
+
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+
+fpc_shared: all
+ifdef inlinux
+ifndef LIBNAME
+	@$(ECHO) "LIBNAME not set"
+else
+	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
+endif
+else
+	@$(ECHO) "Shared Libraries not supported"
+endif
+
+#####################################################################
+# Install rules
+#####################################################################
+
+.PHONY: fpc_showinstall fpc_install
+
+ifdef EXTRAINSTALLUNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
+endif
+
+ifdef INSTALLPPUFILES
+ifdef PPUFILES
+ifdef inlinux
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
+INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
+else
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
+endif
+else
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+endif
+endif
+
+fpc_showinstall: $(SHOWINSTALLTARGET)
+ifdef INSTALLEXEFILES
+	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
+endif
+ifdef INSTALLPPUFILES
+	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
+ifneq ($(INSTALLPPULINKFILES),)
+	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	@$(ECHO) -e $(addprefix "\n"$(DATAINSTALLDIR)/,$(EXTRAINSTALLFILES))
+endif
+
+fpc_install: $(INSTALLTARGET)
+# Create UnitInstallFiles
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(BININSTALLDIR)
+# Compress the exes if upx is defined
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(UNITINSTALLDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	$(MKDIR) $(LIBINSTALLDIR)
+	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	$(MKDIR) $(DATAINSTALLDIR)
+	$(INSTALL) $(EXTRAINSTALLFILES) $(DATAINSTALLDIR)
+endif
+
+#####################################################################
+# SourceInstall rules
+#####################################################################
+
+.PHONY: fpc_sourceinstall
+
+ifndef SOURCETOPDIR
+SOURCETOPDIR=$(BASEDIR)
+endif
+
+fpc_sourceinstall: clean
+	$(MKDIR) $(SOURCEINSTALLDIR)
+	$(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR)
+
+#####################################################################
+# Zip
+#####################################################################
+
+.PHONY: fpc_zipinstall
+
+# Create suffix to add
+ifndef PACKAGESUFFIX
+PACKAGESUFFIX=$(OS_TARGET)
+ifeq ($(OS_TARGET),go32v2)
+PACKAGESUFFIX=go32
+endif
+ifeq ($(OS_TARGET),win32)
+PACKAGESUFFIX=w32
+endif
+endif
+
+# Temporary path to pack a file
+ifndef PACKDIR
+ifndef inlinux
+PACKDIR=$(BASEDIR)/pack_tmp
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+
+# Maybe create default zipname from packagename
+ifndef ZIPNAME
+ifdef PACKAGENAME
+ZIPNAME=$(PACKAGEPREFIX)$(PACKAGENAME)$(PACKAGESUFFIX)
+endif
+endif
+
+# Use tar by default under linux
+ifndef USEZIP
+ifdef inlinux
+USETAR=1
+endif
+endif
+
+fpc_zipinstall:
+ifndef ZIPNAME
+	@$(ECHO) "Please specify ZIPNAME!"
+	@exit 1
+else
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef USETAR
+	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT)
+	cd $(PACKDIR) ; $(TARPROG) c$(TAROPT) --file $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) * ; cd $(BASEDIR)
+else
+	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
+	cd $(PACKDIR) ; $(ZIPPROG) -Dr $(ZIPOPT) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+.PHONY:  fpc_zipsourceinstall
+
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+
+ifdef EXTRACLEANUNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
+endif
+
+ifdef CLEANPPUFILES
+ifdef PPUFILES
+CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
+else
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+endif
+endif
+
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(CLEANRSTFILES)
+endif
+ifdef EXTRACLEANFILES
+	-$(DEL) $(EXTRACLEANFILES)
+endif
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+
+fpc_distclean: fpc_clean
+
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+
+#####################################################################
+# Info rules
+#####################################################################
+
+.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
+	fpc_dirinfo
+
+fpc_info: $(INFOTARGET)
+
+fpc_infocfg:
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC....... $(FPC)
+	@$(ECHO)  Version... $(FPC_VERSION)
+	@$(ECHO)  CPU....... $(CPU_TARGET)
+	@$(ECHO)  Source.... $(OS_SOURCE)
+	@$(ECHO)  Target.... $(OS_TARGET)
+	@$(ECHO)
+
+fpc_infoobjects:
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
+	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
+	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
+	@$(ECHO)
+	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
+	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
+	@$(ECHO)
+	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
+	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
+	@$(ECHO)
+
+fpc_infoinstall:
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+ifdef DATE
+	@$(ECHO)  DateStr.............. $(DATESTR)
+endif
+ifdef PACKAGEPREFIX
+	@$(ECHO)  PackagePrefix........ $(PACKAGEPREFIX)
+endif
+ifdef PACKAGENAME
+	@$(ECHO)  PackageName.......... $(PACKAGENAME)
+endif
+	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
+	@$(ECHO)
+	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
+	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
+	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
+	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
+	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
+	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
+	@$(ECHO)  DataInstallDir....... $(DATAINSTALLDIR)
+	@$(ECHO)
+	@$(ECHO)  DestZipDir........... $(DESTZIPDIR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)
+
+#####################################################################
+# Local Makefile
+#####################################################################
+
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+
+#####################################################################
+# Users rules
+#####################################################################
+
+ifeq ($(OS_TARGET),win32)
+vpath %$(PASEXT) win32
+endif
+.PHONY: text gfx both
+
+clean : execlean fpc_cleanall
+
+execlean :
+	$(DEL) text/*
+	$(DELTREE) text
+	$(DEL) graph/*
+	$(DELTREE) graph
+
+# below projects will call ourselves recursive
+
+text:
+	$(MKDIR) text
+	$(MAKE) all TARGETDIR=text
+
+graph:
+	$(MKDIR) graph
+	$(MAKE) all TARGETDIR=graph GRAPHICS=1
+
+both:
+	$(MAKE) text
+	$(MAKE) graph
+
+#################################
+# Demo installation for linux
+#
+
+# possibly wont work
+
+.PHONY: installexamples
+
+ifndef EXAMPLESINSTALLDIR
+EXAMPLESINSTALLDIR=$(DOCINSTALLDIR)/examples
+endif
+
+installexamples:
+	$(MKDIR) $(EXAMPLESINSTALLDIR)
+	$(COPYTREE) * $(EXAMPLESINSTALLDIR)

install/demo/graph/Makefile.fpc

@@ -0,0 +1,75 @@
+#
+#   Makefile.fpc for FPC graph demos (part of FPC demo package)
+#
+
+[targets]
+units=gameunit
+programs=fpctris
+programs_win32=mandel samegame quad maze gravwars              
+programs_linux=mandel samegame quad maze gravwars
+programs_go32v2=mandel samegame quad maze gravwars
+# anyone who wants to port this sampels on OS/2 ???
+
+[require]
+# Not always necessary, but saves a lot of trouble
+packages=api
+
+[install]
+packagename=demo
+
+[defaults]
+defaultrule=both
+
+[dirs]
+fpcdir=../..
+targetdir=.
+
+[postsettings]
+ifdef GRAPHICS
+override FPCOPT+=-dUSEGRAPHICS
+endif
+
+[rules]
+ifeq ($(OS_TARGET),win32)
+vpath %$(PASEXT) win32
+endif
+.PHONY: text gfx both
+
+clean : execlean fpc_cleanall
+
+execlean :
+        $(DEL) text/*
+        $(DELTREE) text
+        $(DEL) graph/*
+        $(DELTREE) graph
+
+# below projects will call ourselves recursive
+
+text:
+        $(MKDIR) text
+        $(MAKE) all TARGETDIR=text
+
+graph:
+        $(MKDIR) graph
+        $(MAKE) all TARGETDIR=graph GRAPHICS=1
+
+both:
+        $(MAKE) text
+        $(MAKE) graph
+
+#################################
+# Demo installation for linux
+#
+
+# possibly wont work
+
+.PHONY: installexamples
+
+ifndef EXAMPLESINSTALLDIR
+EXAMPLESINSTALLDIR=$(DOCINSTALLDIR)/examples
+endif
+
+installexamples:
+        $(MKDIR) $(EXAMPLESINSTALLDIR)
+        $(COPYTREE) * $(EXAMPLESINSTALLDIR)
+

install/demo/graph/fpctris.pp

@@ -0,0 +1,857 @@
+{
+    $Id$
+
+    This program is both available in XTDFPC as in the FPC demoes.
+    Copyright (C) 1999 by Marco van de Voort
+
+    FPCTris implements a simple Crt driven Tetrisish game to demonstrate the
+    Crt unit. (KeyPressed, ReadKey, GotoXY, Delay,TextColor,TextBackground)
+    Quality games cost money, so that's why this one is free.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+PROGRAM FPCTris;
+{ Trying to make a tetris from zero as a demo for FPC.
+  Problems: - Colorsupport is a hack which handicaps creating a better
+               update mechanism. (is done now)
+            - Graph version input command has no cursor.
+            - Graph or text isn't decided runtime, but compilertime.
+            - Linux status graph version unknown at this moment.
+            - Graphic and textmode speed of the game is not the same.
+               The delay is fixed, and the time required to update is
+               not constant due to optimisations.
+
+  Coordinate system:
+
+   0  ->   TheWidth-1            A figure is coded in a LONGINT like this:
+   ---------
+0 |   *     |                    ..*.            00100000    MSB
+| |   **    |                    ..*.            00100000
+V |   *     |                    .**.            01100000
+  |         |                    ....            00000000    LSB
+  |+   ++ ++|
+  |++ ++++++|                  so  00100000001000000110000000000000b
+  |+++++++++|
+   ---------
+TheHeight-1
+
+}
+
+Uses Crt,Dos,
+{$IFDEF UseGraphics}
+ Graph,
+{$ENDIF}
+ GameUnit;
+
+{$DEFINE DoubleCache}
+
+CONST TheWidth  = 11; {Watch out, also correct RowMask!}
+      TheHeight = 20;
+{$IFNDEF UseGraphics}
+      PosXField = 10; { Upper X,Y coordinates of playfield}
+      PosYField = 3;
+{$ENDIF}
+      MaxFigures= 16; {Maximum # figures place is reserved for.}
+      NrLevels  = 12; {Number of levels currenty defined}
+{      FieldSpace= 177;}
+
+{$IFDEF UseGraphics}
+      DisplGrX=110;
+      DisplGrY=90;
+      DisplGrScale=16;
+      HelpY=130;
+{$ENDIF}
+
+      {$IFDEF UseGraphics}
+       BaseX     =300;   {Coordinates of highscores}
+       BaseY     =HelpY+20+8*LineDistY;  {y coordinate relative to other options}
+      {$ELSE}
+       BaseX     =40;
+       BaseY     =9;
+      {$ENDIF}
+
+TYPE TetrisFieldType = ARRAY [0..25] OF LONGINT;
+     LevelInfoType   = ARRAY [0..NrLevels-1] OF LONGINT;
+     FigureType      = LONGINT;    { actually array[0..4][0..4] of bit rounded up to a longint}
+{     CHARSET         = SET OF CHAR;}
+
+{The figures, are converted to binary bitmaps on startup.}
+
+CONST GraphFigures : ARRAY[0..4] OF String[80] =(
+'.*... .*... .*... ..*.. .*... .*... **... **... ..**. .**.. ..*.. *....',
+'.*... .*... .**.. .**.. .*... .**.. **... .*... ..*.. .**.. ..*.. **...',
+'**... .**.. ..*.. .*... .*... .*... ..... .*... ..*.. .**.. **.** .**..',
+'..... ..... ..... ..... .*... ..... ..... .***. ***.. .**.. ..*.. ..**.',
+'..... ..... ..... ..... ..... ..... ..... ..... ..... .**.. ..*.. .....');
+
+{Their relative occurance : }
+
+      FigureChance : ARRAY[0..MaxFigures-1] OF LONGINT =(
+  8,     8,    8,    8,     8,   8,   10,    1,   1,     1,    1,    1,0,0,0,0 );
+
+{Scores per figure. Not necessarily used. Just for future use}
+
+      FigureScore  : ARRAY[0..MaxFigures-1] OF LONGINT =(
+  2,     2,    4,    4,     1,   2,    2,   10,  10,    10,   20,   10,0,0,0,0 );
+
+{Diverse AND/OR masks to manipulate graphics}
+
+{general table to mask out a bit 31=msb 0=lsb}
+ AndTable : ARRAY[0..31] OF LONGINT=($80000000,$40000000,$20000000,$10000000,
+    $8000000,$4000000,$2000000,$1000000,$800000,$400000,$200000,$100000,
+    $80000,$40000,$20000,$10000,$8000,$4000,$2000,$1000,$800,$400,$200,$100,
+    $80,$40,$20,$10,8,4,2,1);
+
+{Mask to isolate a row of a (FigureType)}
+
+ MagicMasks : ARRAY[0..4] OF LONGINT = ($F8000000,$07C00000,$003E0000,$0001F000,$00000F80);
+
+{Mask to check if a line is full; a bit for every column aligned to left.}
+ RowMask    = $FFE00000;
+
+{Masks to calculate if the left or rightside is partially empty, write them
+in binary, and put 5 bits on a row. }
+
+ LeftMask : ARRAY[0..4] OF LONGINT = ($84210800,$C6318C00,$E739CE00,$F7BDEF00,$FFFFFFE0);
+ RightMask: ARRAY[0..4] OF LONGINT = ($08421080,$18C63180,$39CE7380,$7BDEF780,$FFFFFF80);
+
+{Allowed characters entering highscores}
+
+{This constant/parameter is used to detect a certain bug. The bug was fixed, but
+I use the constant to remind where the bug was, and what is related to eachother.}
+
+   Tune=-1;
+
+{First array is a table to find the level for a given number of dissappeared lines
+ the second and third are the delaytime and iterationlevel per level.  }
+
+  LevelBorders  : LevelInfoType = ( 10, 20, 30, 45, 60, 80,100,130,160,200,240,280);
+  DelayLevel    : LevelInfoType = (100, 90, 80, 70, 60, 60, 50, 40, 40, 20, 20,10);
+  IterationLevel: LevelInfoType = (  5,  5,  5,  5,  5,  4,  4,  4,  3,  3,  2, 2);
+
+{Some frequently used chars in high-ascii and low-ascii. UseColor selects between
+them}
+  ColorString = #196#179#192#217#219;
+  DumbTermStr = '-|..*';
+
+{ A multiplication factor to reward killing more then one line with one figure}
+
+  ProgressiveFactor :  ARRAY[1..5] OF LONGINT = (10,12,16,22,30);
+
+VAR
+    TopX,TopY   : LONGINT;                      {Coordinates figure relative
+                                                  to left top of playfield}
+    FigureNr    : LONGINT;                      {Nr in Figure cache, second
+                                                  index in Figures}
+    {$IFDEF DoubleCache}
+    BackField,                                  {Copy of the screen for faster matching}
+    {$ENDIF}
+    MainField   : TetrisFieldType;              {The screen grid}
+    ColorField  : ARRAY[0..TheHeight-1,0..TheWidth-1] OF LONGINT; {The color info}
+    DelayTime   : LONGINT;                      {Delay time, can be used for
+                                                  implementing levels}
+    IterationPerDelay : LONGINT;                {Iterations of mainloop (incl delay)
+                                                 before the piece falls down a row}
+    TotalChance : LONGINT;                      {Sum of FigureChange array}
+    Lines       : LONGINT;                      {Completed lines}
+    NrFigures   : LONGINT;                      {# Figures currently used}
+    RightSizeArray,                             {Nunber of empty columns to the left }
+    LeftSizeArray,                              {or right of the figure/piece}
+    Figures     : ARRAY[0..MaxFigures-1,0..3] OF LONGINT; {All bitmap info of figures}
+
+    NrFiguresLoaded : LONGINT;                  {Total figures available in GraphFigures}
+    CurrentCol  : LONGINT;                      {Color of current falling piece}
+    UseColor    : BOOLEAN;                      {Color/Mono mode}
+    Level       : LONGINT;                      {The current level number}
+{$IFNDEF UseGraphics}
+    Style       : String;                       {Contains all chars to create the field}
+{$ENDIF}
+    nonupdatemode  : BOOLEAN;                   {Helpmode/highscore screen or game mode}
+{$IFNDEF UseGraphics}
+    HelpMode    : BOOLEAN;
+{$ENDIF}
+    NextFigure  : LONGINT;                      {Next figure to fall}
+    Score       : LONGINT;                      {The score}
+
+
+FUNCTION RRotate(Figure:FigureType;ColumnsToDo:LONGINT):FigureType;
+{Rotate a figure to the right (=clockwise).
+
+This new (v0.06) routine performs a ColumnsTodo x ColumnsToDo rotation,
+instead of always a 4x4 (v0.04) or 5x5 (v0.05) rotation.
+
+This avoids weird, jumpy behaviour when rotating small pieces.}
+
+VAR I,J, NewFig:LONGINT;
+
+BEGIN
+ NewFig:=0;
+ FOR I:=0 TO ColumnsToDo-1 DO
+  FOR J:=0 TO ColumnsToDo-1 DO
+   IF Figure AND AndTable[I*5+J]<>0 THEN
+    NewFig:=NewFig OR AndTable[(ColumnsToDo-1-I)+5*(J)]; {}
+ RRotate:=NewFig;
+END;
+
+{ LeftSize and RightSize count the number of empty lines to the left and
+right of the character. On the below character LeftSize will return 2 and
+RightSize will return 1.
+
+        ..*.
+        ..*.
+        ..*.
+        ..*.
+}
+FUNCTION RightSize(Fig:FigureType):LONGINT;
+
+VAR I : LONGINT;
+
+BEGIN
+ I:=0;
+ WHILE ((Fig AND RightMask[I])=0) AND (I<5) DO
+  INC(I);
+  IF I>4 THEN
+   HALT;
+ Rightsize:=I;
+END;
+
+FUNCTION Leftsize(Fig:FigureType):LONGINT;
+
+VAR I : LONGINT;
+
+BEGIN
+ I:=0;
+ WHILE ((Fig AND LeftMask[I])=0)  AND (I<5) DO
+  INC(I);
+  IF I>4 THEN
+   HALT;
+ Leftsize:=I;
+END;
+
+FUNCTION FigSym(Figure:LONGINT;RightSizeFig:LONGINT):LONGINT;
+ {Try to find the "symmetry" of a figure, the smallest square (1x1,2x2,3x3 etc)
+ in which the figure fits. This requires all figures designed to be aligned to
+ topleft.}
+
+VAR ColumnsToDo : LONGINT;
+
+BEGIN
+ {Determine which bottom rows aren't used}
+
+ ColumnsToDo:=5;
+ WHILE ((Figure AND MagicMasks[ColumnsToDo-1])=0) AND (ColumnsToDo>1) DO
+  DEC(ColumnsToDo);
+
+ {Compare with columns used, already calculated, and take the biggest}
+ IF ColumnsToDo<(5-RightSizeFig) THEN
+  ColumnsToDo:=5-RightSizeFig;
+ FigSym:=ColumnsToDo;
+END;
+
+
+PROCEDURE CreateFiguresArray;
+{Reads figures from ASCII representation into binary form, and creates the
+ rotated representations, and the number of empty columns to the right and
+ left per figure. }
+
+VAR I,J,K,L,Symmetry : LONGINT;
+
+BEGIN
+ NrFigures:=0; K:=1;
+ WHILE K<Length(GraphFigures[0]) DO
+  BEGIN
+   IF GraphFigures[0][K]=' ' THEN
+    INC(K);
+   L:=0;
+   FOR I:=0 TO 4 DO   {Rows}
+    FOR J:=0 TO 4 DO {Columns}
+     IF GraphFigures[I][K+J]='*' THEN
+      L:=L OR AndTable[I*5+J];
+    Figures[NrFigures][0]:=L;
+    INC(NrFigures);
+    INC(K,5);
+  END;
+ NrFiguresLoaded:=NrFigures;
+ FOR I:= 0 TO NrFigures-1 DO
+  BEGIN
+   RightSizeArray[I][0]:=RightSize(Figures[I][0]);
+   LeftSizeArray[I][0]:=LeftSize(Figures[I][0]);
+   Symmetry:=FigSym(Figures[I][0],RightSizeArray[I][0]);
+   FOR J:=0 TO 2 DO                              {Create the other 3 by rotating}
+    BEGIN
+     Figures[I][J+1]:=RRotate(Figures[I][J],Symmetry);
+     RightSizeArray[I][J+1]:=RightSize(Figures[I][J+1]);
+     LeftSizeArray[I][J+1]:=LeftSize(Figures[I][J+1]);
+    END;
+   END;
+{Clear main grid}
+ FillChar(MainField,SIZEOF(TetrisFieldType),0);
+END;
+
+PROCEDURE CalculateTotalChance;
+{Called after a change in the the number of figures, normally 7 (standard)
+or NrFiguresLoaded (10 right now) to recalculate the total of the chance table}
+
+VAR Temp:LONGINT;
+
+BEGIN
+ TotalChance:=0;
+ FOR Temp:=0 TO NrFigures-1 DO INC(TotalChance,FigureChance[Temp]);
+END;
+
+FUNCTION MatchPosition(Fig:FigureType;X,Y:LONGINT): BOOLEAN;
+{Most important routine. Tries to position the figure on the position
+IF it returns FALSE then the piece overlaps something on the background,
+or the lower limit of the playfield
+}
+
+VAR I,J,K  : LONGINT;
+    Match: BOOLEAN;
+
+BEGIN
+ Match:=TRUE;
+ FOR I:=0 TO 4 DO
+  BEGIN
+   K:=Fig;
+   K:=K AND MagicMasks[I];
+   IF K<>0 THEN
+    BEGIN
+     J:=5*(I)-X+Tune;
+     IF J>0 THEN
+      K:=K SHL J
+     ELSE
+      IF J<0 THEN
+       K:=K SHR -J;
+     IF (MainField[Y+I] AND K)<>0 THEN
+      Match:=FALSE;
+   END;
+  END;
+ I:=4;
+ IF (Fig AND MagicMasks[4])=0 THEN
+  DEC(I);
+ IF (Fig AND MagicMasks[3])=0 THEN
+  DEC(I);
+ IF (Fig AND MagicMasks[2])=0 THEN
+  DEC(I);
+ IF (Y+I)>=TheHeight THEN
+  Match:=FALSE;
+ MatchPosition:=Match;
+END;
+
+PROCEDURE FixFigureInField(Fig:FigureType;X,Y:LONGINT;Clear:BOOLEAN);
+{Blends the figure into the background, or erases the figure from the
+background}
+
+VAR I,J,K  : LONGINT;
+
+BEGIN
+ FOR I:=0 TO 4 DO
+  BEGIN
+   K:=Fig;
+    K:=K AND MagicMasks[I];
+   IF K<>0 THEN
+    BEGIN
+     J:=5*I-X+Tune;
+     IF J>0 THEN
+      K:=K SHL J
+     ELSE
+      IF J<0 THEN
+       K:=K SHR (-J);
+     IF Clear THEN
+      BEGIN
+       K:=K XOR -1;
+       MainField[Y+I]:= MainField[Y+I] AND K;
+      END
+     ELSE
+      MainField[Y+I]:= MainField[Y+I] OR K;
+    END;
+ END;
+END;
+
+PROCEDURE FixColField(ThisFig:LONGINT);
+{Puts color info of a figure into the colorgrid, simplified
+FixFigureInField on byte instead of bit manipulation basis.}
+
+VAR I,J,K  : LONGINT;
+
+BEGIN
+ FOR I:=0 TO 4 DO
+  BEGIN
+   K:=Figures[ThisFig][FigureNr];
+   IF (I+TopY)<=TheHeight THEN
+    FOR J:=0 TO 4 DO
+     BEGIN
+      IF (K AND AndTable[J+5*I])<>0 THEN
+       ColorField[TopY+I,TopX-Tune+J]:=CurrentCol
+     END;
+  END;
+END;
+
+PROCEDURE RedrawScreen;
+{Frustrates the caching system so that the entire screen is redrawn}
+
+VAR I : LONGINT;
+
+BEGIN
+ FOR I:=0 TO TheHeight-1 DO
+  BackField[I]:=MainField[I] XOR -1;    {backup copy is opposite of MainField}
+END;
+
+FUNCTION GetNextFigure:LONGINT;
+
+VAR IndTotal,Temp,TheFigure : LONGINT;
+
+BEGIN
+Temp:=RANDOM(TotalChance);
+ IndTotal:=0;
+ TheFigure:=0;
+ WHILE Temp>=IndTotal DO
+  BEGIN
+   INC(IndTotal,FigureChance[TheFigure]);
+   INC(TheFigure);
+  END;
+ dec(thefigure);
+ GetNextFigure:=TheFigure;
+END;
+
+{$IFDEF UseGraphics}
+ {$I ftrisgr.inc}
+{$ELSE}
+ {$I ftristxt.inc}
+{$ENDIF}
+
+
+FUNCTION InitAFigure(VAR TheFigure:LONGINT) : BOOLEAN;
+{A new figure appears in the top of the screen. If return value=FALSE then
+the piece couldn't be created (when it is overlapping with the background.
+That's the game-over condition)}
+
+VAR Temp : LONGINT;
+
+BEGIN
+ TopX:=(TheWidth-4) DIV 2;             { Middle of Screen}
+ TopY:=0;
+ FigureNr:=1;
+ IF TheFigure<>-1 THEN
+  INC(Score,FigureScore[TheFigure]);
+ IF NOT NonUpdateMode THEN
+  FixScores;
+ Temp:=GetNextFigure;                   {Determine next char (after the one this
+                                      initafigure created has got down)}
+ TheFigure:=NextFigure;                 {Previous NextFigure becomes active now.}
+ NextFigure:=Temp;
+ InitAFigure:=MatchPosition(Figures[TheFigure][0],TopX,TopY);
+ ShowNextFigure(NextFigure);
+ CurrentCol:=RANDOM(14)+1;
+END;
+
+PROCEDURE FixLevel(Lines:LONGINT);
+
+
+BEGIN
+ Level:=0;
+ WHILE (Lines>LevelBorders[Level]) AND (Level<HIGH(LevelBorders)) DO
+  INC(Level);
+ DelayTime:=DelayLevel[Level];
+ IterationPerDelay:=IterationLevel[Level];
+END;
+
+PROCEDURE FixMainFieldLines;
+{Deletes full horizontal lines from the playfield will also get some
+score-keeping code in the future.}
+
+VAR I,LocalLines : LONGINT;
+
+BEGIN
+ I:=TheHeight-1;
+ LocalLines:=0;
+ WHILE I>=0 DO
+  BEGIN
+   IF (MainField[I] XOR RowMask)=0 THEN
+    BEGIN
+     Move(MainField[0],MainField[1],I*4);
+     Move(ColorField[0,0],ColorField[1,0],4*I*TheWidth);
+     MainField[0]:=0;
+     FillChar(ColorField[0,0],0,TheWidth);
+     INC(LocalLines);
+    END
+   ELSE
+    DEC(I);
+  END;
+
+ INC(Lines,LocalLines);
+
+ I:=Level;
+ FixLevel(Lines);
+ IF LocalLines<>0 THEN
+  BEGIN
+   INC(Score,ProgressiveFactor[LocalLines]*LocalLines);
+   ShowLines;
+  END;
+ {$IFDEF DoubleCache}
+  IF UseColor THEN
+   RedrawScreen;
+ {$ENDIF}
+END;
+
+PROCEDURE DoFPCTris;
+{The main routine. Initialisation, keyboard loop}
+
+VAR EndGame   : BOOLEAN;
+    FixHickup : LONGINT;
+    Counter   : LONGINT;
+    Temp,Key  : LONGINT;
+    TheFigure : LONGINT;                      {Current first index in Figures}
+
+PROCEDURE TurnFigure;
+{Erases a figure from the grid, turns it if possible, and puts it back on
+again}
+
+BEGIN
+  FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
+  IF MatchPosition(Figures[TheFigure][Temp],TopX,TopY) THEN
+   FigureNr:=Temp;
+  FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+END;
+
+PROCEDURE FixHighScores;
+
+VAR I : LONGINT;
+{$IFNDEF UseGraphics}
+    J : LONGINT;
+{$ENDIF}
+    S : String;
+
+BEGIN
+{$IFDEF UseGraphics}
+  Str(Score:5,S);
+  SetFillStyle(SolidFill,0);            {Clear part of playfield}
+  Bar(DisplGrX+DisplGrScale,DisplGrY + ((TheHeight DIV 2)-2)*DisplGrScale,
+      DisplGrX+(TheWidth-1)*(DisplGrScale), DisplGrY + DisplGrScale*((TheHeight DIV 2)+5));
+  SetTextStyle(0,Horizdir,2);
+  OuttextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)-1),'GAME OVER');
+  SetTextStyle(0,Horizdir,1);
+  OutTextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)+3),'Score= '+S);
+{$ELSE}
+ FOR J:=9 TO 22 DO
+    BEGIN
+     GotoXY(40,J);
+     Write(' ':38);
+    END;
+ IF UseColor THEN
+  TextColor(White);
+ GotoXY(40,23);
+ Writeln('Game Over, score = ',Score);
+{$ENDIF}
+ I:=SlipInScore(Score);
+ IF I<>0 THEN
+  BEGIN
+   NonUpdateMode:=TRUE;
+{$IFNDEF UseGraphics}
+   HelpMode:=FALSE;
+{$ENDIF}
+   ShowHighScore;
+   {$IFDEF UseGraphics}
+    OutTextXY(450,HelpY+20+(17-I+1)*LineDistY,S);
+    GrInputStr(S,300,HelpY+20+(17-I+1)*LineDistY,16,12,10,FALSE,AlfaBeta);
+   {$ELSE}
+    InputStr(S,40,21-I,10,FALSE,AlfaBeta);
+   {$ENDIF}
+   HighScore[I-1].Name:=S;
+  END;
+ ShowHighScore;
+END;
+
+{$IFDEF UseGraphics}
+VAR
+    gd,gm : INTEGER;
+    Pal   : PaletteType;
+{$ENDIF}
+
+BEGIN
+{$IFDEF UseGraphics}
+  gm:=vgahi;
+  gd:=vga;
+  InitGraph(gd,gm,'');
+  if GraphResult <> grOk then
+    begin
+      Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
+      Halt(1);
+    end;
+  SetFillStyle(SolidFill,1);
+  GetDefaultPalette(Pal);
+  SetAllPalette(Pal);
+{$ENDIF}
+
+ {Here should be some terminal-detection for Linux}
+ nonupdatemode:=FALSE;
+{$IFNDEF UseGraphics}
+ HelpMode :=TRUE;
+{$ENDIF}
+ {$IFDEF Linux}
+  UseColor:=FALSE;
+ {$ELSE}
+  UseColor:=TRUE;
+ {$ENDIF}
+ ClrScr;
+ CursorOff;
+ RANDOMIZE;
+ HighX:=BaseX;
+ HighY:=BaseY;
+ CreateFiguresArray;                  { Load and precalculate a lot of stuff}
+{$IFNDEF UseGraphics}
+ IF UseColor THEN
+  Style:= ColorString
+ ELSE
+  Style:=DumbTermStr;
+{$ENDIF}
+
+ NrFigures:=7;                        {Default standard tetris mode, only use
+                                        the first 7 standard figures}
+ CalculateTotalChance;                {Calculated the total of all weightfactors}
+ EndGame:=FALSE;                      {When TRUE, end of game has been detected}
+ FixHickup:=0;                        {Used to avoid unnecessary pauses with the "down key"}
+ CreateFrame;                         {Draws all background garbadge}
+
+ TheFigure:=-1;
+ NextFigure:=GetNextFigure;              {Two figures have to be inited. The first
+                                        figure starts dropping, and that is this
+                                        one}
+ InitAFigure(TheFigure);              {The second figure is the figure to be
+                                       displayed as NEXT. That's this char :-)}
+ DisplMainField;                  {Display/update the grid}
+ Counter:=0;                          {counts up to IterationPerDelay}
+ DelayTime:=200;                      {Time of delay}
+ IterationPerDelay:=4;                {= # Delays per shift down of figure}
+ Lines:=0;                            {Lines that have disappeared}
+ Score:=0;
+ ShowLines;
+ REPEAT
+  IF KeyPressed THEN                  {The function name says it all}
+   BEGIN
+    Key:=ORD(READKEY);
+    IF Key=0 THEN                     {Function key?}
+     Key:=ORD(READKEY) SHL 8;
+    CASE Key OF                       {Check for all keys}
+     ArrU : BEGIN
+             Temp:=(FigureNr+3) AND 3;
+             IF ((TopX+LeftSizeArray[TheFigure][FigureNr])<0) THEN
+              BEGIN
+              IF  (LeftSizeArray[TheFigure][FigureNr]<=LeftSizeArray[TheFigure][Temp]) THEN
+               TurnFigure;
+              END
+             ELSE
+             IF (TopX+7-RightSizeArray[TheFigure][FigureNr])>TheWidth THEN
+              BEGIN
+              IF  (RightSizeArray[TheFigure][FigureNr]<=RightSizeArray[TheFigure][Temp]) THEN
+               TurnFigure;
+              END
+             ELSE
+              TurnFigure;
+           END;
+
+    ArrL  : BEGIN
+             IF (TopX+LeftSizeArray[TheFigure][FigureNr])>=0 THEN
+              BEGIN
+               Temp:=TopX+1-LeftSizeArray[TheFigure][FigureNr];
+               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
+               IF MatchPosition(Figures[TheFigure][FigureNr],TopX-1,TopY) THEN
+                DEC(TopX);
+               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+              END;
+             END;
+
+    ArrR  : BEGIN
+             IF (TopX+7-RightSizeArray[TheFigure][FigureNr])<=TheWidth THEN
+              BEGIN
+               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
+               IF MatchPosition(Figures[TheFigure][FigureNr],TopX+1,TopY) THEN
+                INC(TopX);
+               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+              END;
+             END;
+
+    ArrD  : BEGIN
+             IF FixHickup=0 THEN
+              BEGIN
+             FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
+             Temp:=TopY;
+             WHILE MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) DO
+              INC(TopY);
+             Temp:=TopY-Temp;
+             INC(Score,Temp DIV 2);
+             FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+             FixHickUp:=4;
+             END;
+            END;
+
+ORD('q'),
+   ESC     : BEGIN
+             SetDefaultColor;
+             GotoXY(1,25);
+             EndGame:=TRUE;
+            END;
+
+{$IFNDEF UseGraphics}
+ORD('C'),
+ ORD('c') : BEGIN
+             UseColor:=NOT UseColor;
+             IF UseColor THEN
+              Style:= ColorString
+             ELSE
+              BEGIN
+               SetDefaultColor;
+               Style:=DumbTermStr;
+              END;
+             CreateFrame;
+             RedrawScreen;
+             DisplMainField;
+            END;
+ ORD('S'),
+  ORD('s') : BEGIN
+              IF NOT nonupdatemode THEN
+               BEGIN
+                NonUpdateMode:=TRUE;
+                helpmode:=NOT helpmode;
+               END
+              ELSE
+                HelpMode:=NOT helpmode;
+               CreateFrame;
+               ShowLines;
+               ShowNextFigure(NextFigure);
+              END;
+{$ENDIF}
+ORD('H'),
+ ORD('h') : BEGIN
+             nonupdatemode:=NOT nonupdatemode;
+             CreateFrame;
+             ShowLines;
+             ShowNextFigure(NextFigure);
+            END;
+ORD('E'),
+ ORD('e'): BEGIN                            {Extra figures on/off}
+            IF NrFigures<>NrFiguresLoaded THEN
+              NrFigures:=NrFiguresLoaded     {Extra figures}
+            ELSE
+              NrFigures:=7;                   {Standard Tetris figures}
+            CalculateTotalChance;             {Recalculate weight-totals}
+            IF UseColor THEN
+             SetDefaultColor;
+            ShowGameMode;
+           END;
+
+ORD('p') : BEGIN                             {"p" : Pause}
+             Key:=ORD(ReadKey);
+            IF Key=0 THEN
+             Key:=ORD(ReadKey);
+           END;
+{$IFNDEF UseGraphics}
+{$IFDEF Linux}
+ ORD('i')  : write(#27+'(K');
+{$ENDIF}
+{$ENDIF}
+        END; {END OF Key CASE}
+      END { OF If KeyPressed}
+
+  ELSE
+   BEGIN
+    {$IFDEF Linux}
+     GotoXY(50,10);      {Get cursor out of the way, CursorOn/Off
+                            doesn't work on telnet-terminals}
+    {$ENDIF}
+    Delay(DelayTime);
+   END;
+
+  INC(Counter);
+  IF (Counter=IterationPerDelay) OR (FixHickup=1) THEN
+   BEGIN
+    IF FixHickup=1 THEN
+      Counter:=IterationPerDelay-1
+    ELSE
+     Counter:=0;
+    FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
+    FixHickup:=0;
+    IF MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) THEN
+     BEGIN
+      INC(TopY);
+      FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+     END
+    ELSE
+    BEGIN
+      FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+      FixColField(TheFigure);
+      IF InitAFigure(TheFigure) THEN
+        BEGIN
+         FixMainFieldLines;
+         FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+         DisplMainField;
+         Delay(DelayTime*IterationPerDelay);
+        END
+      ELSE
+       BEGIN
+        FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
+        EndGame:=TRUE;
+       END;
+    END;
+   END
+  ELSE
+   IF FixHickup>1 THEN
+    DEC(FixHickup);
+ DisplMainField;
+ UNTIL EndGame;
+ FixHighScores;
+ CursorOn;
+ SetDefaultColor;
+ GotoXY(1,25);
+ {$IFDEF UseGraphics}
+  TextMode(CO80);
+ {$ENDIF}
+END;
+
+CONST FileName='fpctris.scr';
+
+VAR I : LONGINT;
+
+BEGIN
+ FOR I:=0 TO 9 DO
+  HighScore[I].Score:=(I+1)*750;
+ LoadHighScore(FileName);
+ DoFpcTris;
+ SaveHighScore;
+END.
+
+{
+  $Log$
+  Revision 1.1  2000-03-09 02:40:03  alex
+  moved files
+
+  Revision 1.7  2000/02/22 03:36:48  alex
+  fixed the warning
+
+  Revision 1.5  2000/01/21 00:44:51  peter
+    * remove unused vars
+    * renamed to .pp
+
+  Revision 1.4  2000/01/14 22:03:07  marco
+   * Changed some comments
+
+  Revision 1.3  1999/12/31 17:03:50  marco
+
+
+  Graphical version +2fixes
+
+  Revision 1.2  1999/06/01 19:24:32  peter
+    * updates from marco
+
+  Revision 1.1  1999/05/27 21:36:33  peter
+    * new demo's
+    * fixed mandel for linux
+
+}

install/demo/graph/ftrisgr.inc

@@ -0,0 +1,148 @@
+PROCEDURE ShowLines;
+
+VAR S,S2 : String;
+
+BEGIN
+  SetFillStyle(SolidFill,0);
+  Bar(300,460,550,478);
+  Str(Lines:4,S2);
+  S:='Lines : ';
+  S:=S+S2+'   Level: ';
+  Str(Level:4,S2);
+  S:=S+S2;
+  OutTextXY(300,460,S);
+END;
+
+PROCEDURE ShowGameMode;
+
+BEGIN
+   SetFillStyle(SolidFill,0);
+   Bar(20,440,154,458);
+   IF NrFigures<>7 THEN
+    OutTextXY(20,440,'GameMode: Extended')
+   ELSE
+    OutTextXY(20,440,'GameMode: Standard')
+END;
+
+PROCEDURE CreateFrame;
+{Used once to print the "background" of the screen (not the background grid,
+but the text, and the cadre around the playfield)}
+
+BEGIN
+ setbkcolor(black);
+ setviewport(0,0,getmaxx,getmaxy,clipoff);
+ clearviewport;
+ SetTextStyle(0,Horizdir,2);
+ OuttextXY(30,50,'FPCTris v0.08, (C) by Marco v/d Voort.');
+ SetTextStyle(0,Horizdir,1);
+ OutTextXY(300,HelpY-30,'A demo of the FPC Graph unit');
+
+ VLine(DisplGrX-1,DisplGrY,DisplGrY+DisplGrScale*TheHeight);
+ VLine(DisplGrX+TheWidth*DisplGrScale,DisplGrY,DisplGrY+DisplGrScale*TheHeight);
+ HLine(DisplGrX-1,DisplGrX+TheWidth*DisplGrScale,DisplGrY+DisplGrScale*TheHeight);
+
+ {Clean below area}
+ ShowGameMode;
+ OutTextXY(300,HelpY,'Arrow left/right to move, down to drop');
+ OutTextXY(300,HelpY+LineDistY,'arrow-up to rotate the piece');
+ OutTextXY(300,HelpY+2*LineDistY,'"P" to pause');
+ OutTextXY(300,HelpY+3*LineDistY,'"E" Mode (standard or extended)');
+ OutTextXY(300,HelpY+5*LineDistY,'Escape to quit');
+ OutTextXY(300,HelpY+20+6*LineDistY,'The Highscores');
+ ShowHighScore;
+END;
+
+PROCEDURE DisplMainField;
+{Graph mode version. Always caches.}
+
+
+VAR Row,Column,Difference,StartRow,EndRow,
+    L : LONGINT;
+{    LastCol : LONGINT; }
+
+BEGIN
+ FOR Row:=0 TO TheHeight-1 DO
+  BEGIN
+   IF BackField[Row]<>MainField[Row] THEN
+    BEGIN
+     StartRow:=0;
+     EndRow:=TheWidth-1;
+     Difference:=MainField[Row] XOR BackField[Row];     {Calc differences in line}
+     WHILE ((Difference AND AndTable[StartRow])=0) AND
+        (StartRow<(TheWidth-1)) DO
+      INC(StartRow);
+     WHILE ((Difference AND AndTable[EndRow])=0) AND (EndRow>0) DO
+      DEC(EndRow);
+     FOR Column:=StartRow To EndRow DO
+      BEGIN
+       IF (MainField[Row] AND AndTable[Column])<>0 THEN
+       BEGIN
+         L:=ColorField[Row,Column];
+         IF L=0 THEN
+          L:=CurrentCol;
+         IF L<>255 THEN
+          BEGIN
+           L:=L AND 15;
+           SetFillStyle(SolidFill,L);
+           Bar((Column)*DisplGrScale+DisplGrX,DisplGrY+DisplGrScale*Row,(Column+1)*DisplGrScale-1+DisplGrX,DisplGrY+DisplGrScale*(Row)+DisplGrScale-1);
+          END;
+        END
+       ELSE
+        BEGIN
+           SetFillStyle(SolidFill,0);
+           Bar((Column)*DisplGrScale+DisplGrX,DisplGrY+DisplGrScale*Row,(Column+1)*DisplGrScale-1+DisplGrX,DisplGrY+DisplGrScale*(Row)+DisplGrScale-1);
+        END
+      END;
+   END;
+  END;
+  BackField:=MainField;     {Keep a copy of the screen for faster updates
+                              of terminals, for next DisplMainField.}
+END;
+
+PROCEDURE ShowNextFigure(ThisFig:LONGINT);
+
+CONST NextFigX=10;
+      NextFigY=120;
+      NextFigDim=16;
+
+VAR I,J,K  : LONGINT;
+
+BEGIN
+ IF NOT nonupdatemode THEN
+  BEGIN
+   FOR I:=0 TO 4 DO
+    BEGIN
+     K:=Figures[ThisFig][FigureNr] AND MagicMasks[I];
+     IF K=0 THEN
+      BEGIN
+       SetFillStyle(SolidFill,0);
+       Bar(NextFigX,NextFigY+I*NextFigDim,NextFigX+5*NextFigDim-1,NextFigY+(I+1)*NextFigDim);
+      END
+     ELSE
+      BEGIN
+       FOR J:=0 TO 5 DO
+         IF (K And AndTable[J+5*I])=0 THEN
+          BEGIN
+           SetFillStyle(SolidFill,0);
+           Bar(NextFigX+J*NextFigDim,NextFigY+I*NextFigDim,NextFigX++(J+1)*NextFigDim,NextFigY+(I+1)*NextFigDim);
+          END
+         ELSE
+          BEGIN
+           SetFillStyle(SolidFill,1);
+           Bar(NextFigX+J*NextFigDim,NextFigY+I*NextFigDim,NextFigX++(J+1)*NextFigDim,NextFigY+(I+1)*NextFigDim);
+          END;
+       END;
+    END;
+  END;
+END;
+
+PROCEDURE FixScores;
+
+VAR S : String;
+
+BEGIN
+   Str(Score:5,S);
+   SetFillStyle(SolidFill,0);
+   Bar(300,440,450,458);
+   OutTextXY(300,440,'Score :'+S);
+END;

install/demo/graph/ftristxt.inc

@@ -0,0 +1,238 @@
+PROCEDURE ShowLines;
+
+BEGIN
+ IF NOT nonupdatemode THEN
+  BEGIN
+   IF UseColor THEN
+    TextColor(Yellow);
+   GotoXY(40,16); Write('Lines: ',Lines:4,'    Level: ',Level);
+  END;
+END;
+
+PROCEDURE ShowGameMode;
+
+BEGIN
+ IF NOT nonupdatemode THEN
+  BEGIN
+   GotoXY(61,13);
+   IF NrFigures<>7 THEN
+    write('Extended')
+   ELSE
+    write('Standard');
+  END;
+END;
+
+
+PROCEDURE CreateFrame;
+{Used once to print the "background" of the screen (not the background grid,
+but the text, and the cadre around the playfield}
+
+VAR I : LONGINT;
+
+BEGIN
+ SetDefaultColor;
+ GotoXY(40,4);
+ Write('FPCTris v0.08, (C) by Marco van de Voort');
+ GotoXY(40,6);
+ Write('A demo of the FPC Crt unit, and');
+ GotoXY(40,7);
+ Write(' its portability');
+ FOR I:=9 TO 24 DO
+  BEGIN
+   GotoXY(40,I);
+   Write(' ':38);
+  END;
+ ShowGameMode;
+ IF nonupdatemode THEN
+  BEGIN
+   IF HelpMode THEN
+    BEGIN
+   GotoXY(40,9);
+   Write('Arrow left/right to move, down to drop');
+   GotoXY(40,10);
+   Write('arrow-up to rotate the piece');
+   GotoXY(40,11);
+   Write('"P" to pause');
+   GotoXY(40,12);
+   Write('"E" Mode (standard or extended)');
+   GotoXY(40,13);
+   Write('"C" switches between color/mono mode');
+   GotoXY(40,14);
+   Write('Escape to quit');
+   GotoXY(40,15);
+   Write('"S" to show the highscores');
+   {$IFDEF Linux}
+   GotoXY(40,16);
+   Write('"i" try to switch to IBM character set');
+   {$ENDIF}
+   END
+   ELSE
+    ShowHighScore;
+  END
+ ELSE
+  BEGIN
+   GotoXY(40,9);
+   Write('"h" to display the helpscreen');
+  END;
+
+ FOR I :=0 TO TheHeight-1 DO
+  BEGIN
+   GotoXY(PosXField-1 ,PosYField+I); Write(Style[2]);
+   GotoXY(PosXField+2*TheWidth ,PosYField+I); Write(Style[2]);
+  END;
+ GotoXY(PosXField-1,PosYField+TheHeight);
+ Write(Style[3]);
+ FOR I:=0 TO (2*TheWidth)-1 DO
+  Write(Style[1]);
+ Write(Style[4]);
+END;
+PROCEDURE DisplMainFieldMono;
+{Displays the grid with a simple buffering algoritm, depending on
+conditional DoubleBuffer}
+
+VAR Row,Column,Difference,StartRow,EndRow : LONGINT;
+    S : String;
+
+BEGIN
+ FOR Row:=0 TO TheHeight-1 DO
+  BEGIN
+   {$IFDEF DoubleCache}
+    IF BackField[Row]<>MainField[Row] THEN
+     BEGIN
+    {$ENDIF}
+   FillChar(S[1],2*TheWidth,#32);
+   StartRow:=0;
+   EndRow:=TheWidth-1;
+   {$IFDEF DoubleCache}
+    Difference:=MainField[Row] XOR BackField[Row];     {Calc differences in line}
+    {Search for first and last bit changed}
+    WHILE ((Difference AND AndTable[StartRow])=0) AND (StartRow<(TheWidth-1)) DO
+     INC(StartRow);
+    WHILE ((Difference AND AndTable[EndRow])=0) AND (EndRow>0) DO
+     DEC(EndRow);
+   {$ENDIF}
+   {Prepare a string}
+   GotoXY(PosXField+2*StartRow,PosYField+Row);
+   S[0]:=CHR(2*(EndRow-StartRow+1));
+   FOR Column:=0 TO EndRow-StartRow DO
+    BEGIN
+     IF (MainField[Row] AND AndTable[StartRow+Column])<>0 THEN
+      BEGIN
+       S[Column*2+1]:=Style[5];
+       S[Column*2+2]:=Style[5];
+      END;
+    END;
+   {Write the string}
+   Write(S);
+   {$IFDEF DoubleCache}
+    END;
+   {$ENDIF}
+  END;
+ {$IFDEF DoubleCache}
+  BackField:=MainField;     {Keep a copy of the screen for faster updates
+                              of terminals, for next DisplMainField.}
+ {$ENDIF}
+END;
+
+PROCEDURE DisplMainFieldColor;
+{Same as above, but also use ColorField to output colors,
+ the buffering is the same, but the colors make it less efficient.}
+
+VAR Row,Column,Difference,StartRow,EndRow,
+    L : LONGINT;
+    S   : String;
+    LastCol : LONGINT;
+
+BEGIN
+ LastCol:=255;
+ FOR Row:=0 TO TheHeight-1 DO
+  BEGIN
+   {$IFDEF DoubleCache}
+    IF BackField[Row]<>MainField[Row] THEN
+     BEGIN
+    {$ENDIF}
+   FillChar(S[1],2*TheWidth,#32);
+   StartRow:=0;
+   EndRow:=TheWidth-1;
+   {$IFDEF DoubleCache}
+    Difference:=MainField[Row] XOR BackField[Row];     {Calc differences in line}
+    WHILE ((Difference AND AndTable[StartRow])=0) AND (StartRow<(TheWidth-1)) DO
+     INC(StartRow);
+    WHILE ((Difference AND AndTable[EndRow])=0) AND (EndRow>0) DO
+     DEC(EndRow);
+   {$ENDIF}
+   GotoXY(PosXField+2*StartRow,PosYField+Row);
+   FOR Column:=0 TO EndRow-StartRow DO
+    BEGIN
+     IF (MainField[Row] AND AndTable[StartRow+Column])<>0 THEN
+      BEGIN
+       L:=ColorField[Row,StartRow+Column];
+       IF L=0 THEN
+        L:=CurrentCol;
+       IF L<>LastCol THEN
+        BEGIN
+         TextColor(L);
+         Write(Style[5],Style[5]);
+        END;
+      END
+     ELSE
+      Write('  ');
+    END;
+   {$IFDEF DoubleCache}
+    END;
+   {$ENDIF}
+  END;
+ {$IFDEF DoubleCache}
+  BackField:=MainField;     {Keep a copy of the screen for faster updates
+                              of terminals, for next DisplMainField.}
+ {$ENDIF}
+END;
+
+PROCEDURE DisplMainField;
+{Main redraw routine; Check in what mode we are and call appropriate routine}
+
+BEGIN
+   IF UseColor THEN
+    DisplMainFieldColor
+   ELSE
+    DisplMainFieldMono;
+END;
+
+
+PROCEDURE ShowNextFigure(ThisFig:LONGINT);
+
+VAR I,J,K  : LONGINT;
+    S      : String[8];
+
+BEGIN
+ IF UseColor THEN
+  TextColor(White);
+ IF NOT nonupdatemode THEN
+  BEGIN
+   FOR I:=0 TO 4 DO
+    BEGIN
+     FillChar(S,9,' ');
+     S[0]:=#8;
+     K:=Figures[ThisFig][FigureNr];
+     IF (I+TopY)<=TheHeight THEN
+      FOR J:=0 TO 4 DO
+       BEGIN
+        IF (K AND AndTable[J+5*I])<>0 THEN
+         BEGIN
+          S[J*2+1]:=Style[5];
+          S[J*2+2]:=Style[5];
+         END
+       END;
+     GotoXY(50,11+I); Write(S);
+    END;
+  END;
+END;
+
+PROCEDURE FixScores;
+
+BEGIN
+   IF UseColor THEN
+    SetDefaultColor;
+   GotoXY(40,18);
+   Write('Score :',Score);
+END;

install/demo/graph/gameunit.pp

@@ -0,0 +1,893 @@
+{
+    $Id$
+
+    A simple unit with some common used routines for FPCGames (FpcTris and
+      SameGame)
+
+    Contains
+     - Highscore routines "developped" for FPCTris, but now also used by SameGame
+     - "Dummy" mouse routines which either shell to API units or to MSMouse.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+UNIT GameUnit;
+
+INTERFACE
+
+{MouseAPI defined : unit unes API mouse units, which requires that package,
+                    but also works under Linux
+ MouseAPI undef   : RTL unit MsMouse. API not required, but doesn't work under
+                    Linux }
+
+
+{$ifdef linux}
+  {$define MouseAPI}
+{$endif}
+{$ifdef win32}
+  {$define MouseAPI}
+{$endif}
+{$IFDEF Ver70}
+  {$define MouseAPI}
+  {$G+}
+{$endif}
+{$IFDEF Ver60}
+  {$define MouseAPI}
+  {$G+}
+{$endif}
+{$IFDEF Ver55}
+  {$define MouseAPI}
+  {$G+}
+{$endif}
+CONST  LineDistY=13;
+
+
+TYPE CHARSET=SET OF CHAR;
+
+{----   Unified Mouse procedures. ---- }
+
+FUNCTION MousePresent : BOOLEAN;
+
+PROCEDURE HideMouse;
+PROCEDURE ShowMouse;
+PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT);
+PROCEDURE DoneMouse;
+PROCEDURE InitMouse;
+PROCEDURE SetMousePosition(X,Y:LONGINT);
+
+
+Const LButton = 1; {left button}
+      RButton = 2; {right button}
+      MButton = 4; {middle button}
+
+
+{---- Standard Highscore procedures ----}
+
+TYPE  HighScoreType   = Packed RECORD
+                        Name : String[15];
+                        Score: LONGINT;
+                       END;
+     HighScoreArr    = ARRAY[0..9] OF HighScoreType;
+
+VAR HighScore   : HighScoreArr;
+    ScorePath   : String;
+    HighX,HighY : LONGINT;
+    Negative    : BOOLEAN;      { Negative=true-> better scores are lower}
+
+PROCEDURE LoadHighScore(FileName:STRING);
+PROCEDURE SaveHighScore;
+PROCEDURE ShowHighScore;
+
+FUNCTION  SlipInScore(Score:LONGINT):LONGINT;
+
+{---- Keyboard routines ----}
+
+CONST {Constants for GetKey}
+   ArrU   = $04800;    ArrL   = $04B00;    ArrR   = $04D00;   BS  = $08;  (* Backspace *)
+   ArrD   = $05000;    CR     = $0D;       ESC    = $1B;      KDelete= $05300;
+   KInsert= $05200;    Home   = $04700;    KEnd   = $04F00;   CtrlY = $19;
+   CtrlT = $14;
+
+CONST FieldSpace : CHAR = #177;
+      AlfaBeta : CHARSET= [' '..'z'];
+
+FUNCTION GetKey:LONGINT;
+
+{Generic string input routine}
+{$IFDEF UseGraphics}
+FUNCTION  GrInputStr(VAR S:String;X,Y,Len,dX,dY:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
+{$ELSE}
+FUNCTION  InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
+{$ENDIF}
+
+{---- Misc ----}
+
+PROCEDURE SetDefaultColor; {Restore the attribs saved on startup}
+
+{BP compability}
+
+{$IFNDEF FPC}
+PROCEDURE SetCursorSize(CurDat:WORD);
+FUNCTION  GetCursorSize:WORD;
+PROCEDURE CursorOn;
+PROCEDURE CursorOff;
+
+{Non Go32 but not existant in BP}
+PROCEDURE FillWord(VAR Data;Count,Value:WORD);
+
+PROCEDURE dosmemfillword(Segx,xofs,Count,Value:WORD);
+PROCEDURE dosmemput(Segx,xofs:WORD;VAR Data;Count:WORD);
+PROCEDURE dosmemget(Segx,xofs:WORD;VAR Data;Count:WORD);
+
+FUNCTION  inportb(portx : word) : byte;
+PROCEDURE outportb(portx : word;data : byte);
+
+FUNCTION  inportw(portx : word) : word;
+PROCEDURE outportw(portx : word;data : word);
+
+FUNCTION  inportl(portx : word) : longint;
+PROCEDURE outportl(portx : word;data : longint);
+{$ENDIF}
+
+IMPLEMENTATION
+
+{$IFDEF MouseAPI}
+ {$IFDEF UseGraphics}
+  Uses Mouse,Dos,Crt,Graph;
+ {$ELSE}
+  Uses Mouse,Dos,Crt;
+ {$ENDIF}
+{$ELSE}
+  {$IFDEF UseGraphics}
+  Uses MsMouse,Dos,Crt,Graph;
+ {$ELSE}
+  Uses MsMouse,Dos,Crt;
+ {$ENDIF}
+{$ENDIF}
+
+VAR  DefColor    : BYTE;                         {Backup of startup colors}
+
+CONST
+
+{The initial names. If people feel they are missing, I first checked the Alias,
+  and then filled with names of the FPC-Devel list, and arranged them alfabetically}
+  InitNames : ARRAY[0..9] OF String[12] = ('Carl','Daniel','Florian','Jonas','John','Marco','Michael (3x)',
+                                           'Peter','Pierre','Thomas' );
+
+FUNCTION MousePresent : BOOLEAN;
+
+BEGIN
+ {$IFDEF MouseAPI}
+  MousePresent:=DetectMouse<>0;
+ {$ELSE}
+  MousePresent:=MouseFound;
+ {$ENDIF}
+END;
+
+PROCEDURE ShowMouse;
+
+BEGIN
+  {$IFDEF MouseAPI}
+  Mouse.ShowMouse;
+ {$ELSE}
+  MsMouse.ShowMouse;
+ {$ENDIF}
+END;
+
+PROCEDURE HideMouse;
+
+BEGIN
+ {$IFDEF MouseAPI}
+  Mouse.HideMouse;
+ {$ELSE}
+  MsMouse.HideMouse;
+ {$ENDIF}
+END;
+
+PROCEDURE InitMouse;
+
+BEGIN
+ {$IFDEF MouseAPI}
+  Mouse.InitMouse;
+ {$ELSE}
+  MsMouse.InitMouse;
+ {$ENDIF}
+END;
+
+PROCEDURE DoneMouse;
+
+BEGIN
+ {$IFDEF MouseAPI}
+  Mouse.DoneMouse;
+ {$ENDIF}
+END;
+
+PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT);
+
+  {$IFDEF MouseAPI}
+   VAR MouseEvent : TMouseEvent;
+  {$ENDIF}
+
+BEGIN
+  {$IFDEF MouseAPI}
+   GetMouseEvent(MouseEvent);
+   MX:=MouseEvent.X SHL 3;
+   MY:=MouseEvent.Y SHL 3;
+   MState:=MouseEvent.Buttons;
+ {$ELSE}
+  MsMouse.GetMouseState(MX,MY,MState);
+ {$ENDIF}
+END;
+
+PROCEDURE SetMousePosition(X,Y:LONGINT);
+
+BEGIN
+ {$IFDEF MouseAPI}
+  SetMouseXY(x,y);
+ {$ELSE}
+  SetMousePos(X,Y);
+ {$ENDIF}
+END;
+
+Procedure LoadHighScore(FileName:STRING);
+
+var
+ F: File;
+ I : LONGINT;
+ OFileMode : LONGINT;
+
+BEGIN
+ {$I-}
+ Assign(F, FileName);
+ OFileMode:=FileMode;
+ FileMode := 0;  {Set file access to read only }
+ Reset(F);
+ Close(F);
+ {$I+}
+ IF IOResult=0 THEN
+  ScorePath:=FileName
+ ELSE
+  ScorePath:=FSearch(FileName,GetEnv('PATH'));
+ IF ScorePath='' THEN
+  BEGIN
+   FOR I:=0 TO 9 DO
+    BEGIN
+     HighScore[I].Name:=InitNames[I];
+     HighScore[I].Score:=(I+1)*750;
+    END;
+   ScorePath:=FileName;
+  END
+ ELSE
+  BEGIN
+   Assign(F,ScorePath);
+   Reset(F,1);
+   BlockRead(F,HighScore,SIZEOF(HighScoreArr));
+   Close(F);
+  END;
+ FileMode:=OFileMode;
+END;
+
+Procedure SaveHighScore;
+
+var
+ F: File;
+
+BEGIN
+ Assign(F,ScorePath);
+ Rewrite(F,1);
+ BlockWrite(F,HighScore,SIZEOF(HighScoreArr));
+ Close(F);
+END;
+
+FUNCTION  SlipInScore(Score:LONGINT):LONGINT;
+
+VAR I,J : LONGINT;
+
+BEGIN
+ IF Negative THEN
+  Score:=-Score;
+ I:=0;
+ WHILE (Score>HighScore[I].Score) AND (I<10) DO
+  INC(I);
+ IF I<>0 THEN
+  BEGIN
+   IF I>1 THEN
+    FOR J:=0 TO I-2 DO
+     HighScore[J]:=HighScore[J+1];
+    HighScore[I-1].Score:=Score;
+    HighScore[I-1].Name:='';
+  END;
+ SlipInScore:=I;
+END;
+
+{$IFDEF UseGraphics}
+
+PROCEDURE ShowHighScore;
+
+VAR I : LONGINT;
+    S : String;
+
+BEGIN
+ SetFillStyle(SolidFill,0);            {Clear part of playfield}
+ Bar(HighX,HighY, 638, HighY+20+18*LineDistY);
+ FOR I:=0 TO 9 DO
+  BEGIN
+   OutTextXY(HighX,HighY+(9-I)*LineDistY,HighScore[I].Name);
+   IF Negative THEN
+    Str(-HighScore[I].Score:5,S)
+   ELSE
+    Str(HighScore[I].Score:5,S);
+   OutTextXY(HighX+150,HighY+(9-I)*LineDistY,S);
+  END;
+END;
+
+{$ELSE}
+PROCEDURE ShowHighScore;
+
+VAR I : LONGINT;
+
+{HighX=40 HighY=9}
+
+BEGIN
+ GotoXY(HighX+5,9); Write('The Highscores');
+ FOR I:=0 TO 9 DO
+  BEGIN
+   GotoXY(HighX,HighY+11-I);
+   Write(HighScore[I].Name,' ':(13-Length(HighScore[I].Name)),' ');
+   IF NOT Negative THEN     { Negative=true-> better scores are lower}
+    Write(HighScore[I].Score:5)
+   ELSE
+    Write(-HighScore[I].Score:5)
+  END;
+END;
+{$ENDIF}
+
+FUNCTION GetKey:LONGINT;
+
+VAR InKey: LONGINT;
+
+BEGIN
+ InKey:=ORD(ReadKey);
+ IF InKey=0 THEN InKey:=ORD(ReadKey) SHL 8;
+ GetKey:=InKey;
+END;
+
+{$IFNDEF UseGraphics}
+FUNCTION  InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
+{
+  Input a string from keyboard, in a nice way,
+   allowed characters are in CHARSET CharAllow, but several editting
+   keys are always allowed, see CASE loop.
+
+Parameters:
+
+   X,Y       Coordinates field
+   Len       Length field
+   TextIn    S already filled?}
+
+VAR
+    InGev                     : LONGINT; { No. of chars inputted }
+    Posi                      : LONGINT; { Cursorposition}
+    Ins                       : BOOLEAN;  { Insert yes/no}
+    Key                       : LONGINT; { Last key as ELib.GetKey
+                                            code <255 if normal key,
+                                            >256 if special/function
+                                            key. See keys.inc}
+    Uitg                      : String;    {The inputted string}
+    Full                      : BOOLEAN;   { Is the string full? }
+    EndVal                    : WORD;
+
+PROCEDURE ReWr; { Rewrite the field, using Uitg}
+
+VAR    I                         : LONGINT;  { Temporary variabele }
+
+BEGIN
+ IF Length(Uitg)>Len THEN
+  Uitg[0]:=CHR(Len);
+ IF Length(Uitg)>0 THEN
+  FOR I:= 1 TO Length(Uitg) DO
+   BEGIN
+    GotoXY(X+I-1,Y);
+    IF Uitg[I]=CHR(32) THEN
+     Write(FieldSpace)
+    ELSE
+     Write(Uitg[I]);
+   END;
+ IF Len<>Length(Uitg) THEN
+  BEGIN
+   GotoXY(X+Length(Uitg),Y);
+   FOR I:= Length(Uitg) TO Len-1 DO
+    Write(FieldSpace);
+  END;
+END;
+
+PROCEDURE DoCursor; { Put Cursor in/out insert-mode }
+
+BEGIN
+ {$IFNDEF Linux}
+{ IF Ins THEN
+  SetCursorSize($11E)
+ ELSE
+  SetCursorSize($71E); }
+ {$ENDIF}
+
+END;
+
+BEGIN
+    { Init }
+
+  InGev :=0;              { 0 chars untill now }
+  Posi  :=1;               { Cursorposition 0 }
+  Ins   :=TRUE;            { Insert according to parameters }
+  DoCursor;        { Set cursor accordingly }
+  Key   :=0;
+
+       { put ±±± padded field on screen }
+
+  FillChar(Uitg,Len+1,FieldSpace);
+  Uitg[0]:=CHR(Len);
+  ReWr;
+  GotoXY(X,Y);
+
+  FillChar(Uitg,Len,32);
+  UitG[0]:=#0;
+
+  IF TextIn THEN
+   BEGIN
+    Uitg:=S;
+    Posi:=Length(Uitg)+1;                        { Put a predefined }
+    ReWr;                                   {  String on screen if specified }
+   END;
+
+  EndVal:=0;
+  WHILE EndVal=0 DO
+   BEGIN
+    Full:=FALSE;
+    IF ((Posi)>=Len) THEN
+     BEGIN
+      Full:=TRUE;
+      Posi:=Len;
+     END;
+    GotoXY(X+Posi-1,Y);
+    {$IFNDEF Linux}
+     {$IFDEF FPC}
+      CursorOn;
+     {$ENDIF}
+    DoCursor;
+    {$ENDIF}
+    Key:=GetKey;
+   {$IFNDEF Linux}
+    {$IFDEF FPC}
+    CursorOff;
+    {$ENDIF}
+   {$ENDIF}
+    CASE Key OF
+          CR              : BEGIN
+                             EndVal:=1;
+                             S:=UitG;
+                            END;
+          ESC             : EndVal:=2;
+          BS              : IF Posi>1 THEN       { BackSpace }
+                              BEGIN
+                               DEC(Posi);
+                               Delete(Uitg,Posi,1);
+                               DEC(InGev);
+                               ReWr;
+                              END;
+          KDelete          : BEGIN
+                              Delete(Uitg,Posi,1);
+                              DEC(InGev);
+                              ReWr;
+                             END;
+          ArrR            : IF (NOT Full) AND ((Posi-1)<InGev) THEN
+                              BEGIN
+                               INC (Posi);
+                               GotoXY(X+Posi-1,Y);
+                               END;
+          KInsert          : BEGIN
+                               Ins:= NOT Ins;
+                               DoCursor;
+                              END;
+          ArrL            : IF (NOT (Posi=1)) THEN
+                              BEGIN
+                               DEC (Posi);
+                               GotoXY(X+Posi-1,Y);
+                              END;
+          Home            : Posi:=1;
+          KEnd            : Posi:=InGev-1;
+          CtrlY           : BEGIN
+                             Delete(Uitg,Posi,Length(Uitg)-Posi);
+                             ReWr;
+                            END;
+          CtrlT           : BEGIN
+                             Uitg[0]:=#0; Posi:=1; ReWr;
+                            END;
+    END; {Case}
+   IF EndVal=0 THEN
+    BEGIN
+     IF (CHR(Key) IN CharAllow) THEN
+      BEGIN
+       IF Posi>Len THEN
+        Posi:=Len;
+       IF (Ins=FALSE) OR Full THEN
+        BEGIN
+         IF (ORD(Uitg[0])<Posi) THEN
+           Uitg[0]:=CHR(Posi);
+         Uitg[Posi]:=CHR(Key);
+        END
+       ELSE
+        BEGIN
+         Insert(CHR(Key),Uitg,Posi);
+        END;
+       ReWr;
+       INC(Posi);
+      END;
+     END;
+    InGev:=Length(Uitg);
+   END;
+  InputStr:=Endval=1;
+END;
+{$ENDIF}
+
+{$IFDEF UseGraphics}
+FUNCTION  GrInputStr(VAR S:String;X,Y,Len,dX,dY:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
+{As the (older) textversion except:
+    -  oX,oY are in pixels.
+    -  dX,dY are the dimensions of the font.
+    -  Len is still characters ( length in pixels/dX)
+}
+
+
+VAR
+    InGev                     : LONGINT; { No. of chars inputted }
+    Posi                      : LONGINT; { Cursorposition}
+    Ins                       : BOOLEAN;  { Insert yes/no}
+    Key                       : LONGINT; { Last key as ELib.GetKey
+                                            code <255 if normal key,
+                                            >256 if special/function
+                                            key. See keys.inc}
+    Uitg                      : String;    {The inputted string}
+    Full                      : BOOLEAN;   { Is the string full? }
+    EndVal                    : WORD;
+
+PROCEDURE ReWr; { Rewrite the field, using Uitg}
+
+VAR    I                         : LONGINT;  { Temporary variabele }
+       S                         : String;
+
+BEGIN
+ FillChar(S[1],Len,FieldSpace);
+ S:=Uitg;
+ IF Length(Uitg)>Len THEN
+  SetLength(Uitg,Len);
+ SetLength(S,Len);
+ IF Length(S)>0 THEN
+  BEGIN
+   FOR I:= 1 TO Length(S) DO
+    IF S[I]=CHR(32) THEN
+     S[I]:=FieldSpace;
+   SetFillStyle(SolidFill,0);
+   Bar(X,Y,X+Len*Dx+5,Y+Dy+1);
+   OutTextXY(X,Y,S);
+  END;
+END;
+
+PROCEDURE DoCursor; { Put Cursor in/out insert-mode }
+
+BEGIN
+ {$IFNDEF Linux}
+{ IF Ins THEN
+  SetCursorSize($11E)
+ ELSE
+  SetCursorSize($71E); }
+ {$ENDIF}
+END;
+
+BEGIN
+    { Init }
+
+  InGev :=0;              { 0 chars untill now }
+  Posi  :=1;               { Cursorposition 0 }
+  Ins   :=TRUE;            { Insert according to parameters }
+  DoCursor;        { Set cursor accordingly }
+  Key   :=0;
+//  SetFillStyle(SolidFill,0);
+//  Bar(X,Y,X+Len*Dx+5,Y+Dy+1);
+       { put ±±± padded field on screen }
+
+  FillChar(Uitg,Len+1,FieldSpace);
+  Uitg[0]:=CHR(Len);
+  ReWr;
+//  GotoXY(X,Y);
+  FillChar(Uitg,Len,32);
+  SetLength(UitG,0);
+
+  IF TextIn THEN
+   BEGIN
+    Uitg:=S;
+    Posi:=Length(Uitg)+1;                        { Put a predefined }
+    ReWr;                                   {  String on screen if specified }
+   END;
+
+  EndVal:=0;
+  WHILE EndVal=0 DO
+   BEGIN
+    Full:=FALSE;
+    IF ((Posi)>=Len) THEN
+     BEGIN
+      Full:=TRUE;
+      Posi:=Len;
+     END;
+    {$IFNDEF Linux}
+     {$IFDEF FPC}
+      CursorOn;
+     {$ENDIF}
+    DoCursor;
+    {$ENDIF}
+    Key:=GetKey;
+   {$IFNDEF Linux}
+    {$IFDEF FPC}
+    CursorOff;
+    {$ENDIF}
+   {$ENDIF}
+    CASE Key OF
+          CR              : BEGIN
+                             EndVal:=1;
+                             S:=UitG;
+                            END;
+          ESC             : EndVal:=2;
+          BS              : IF Posi>1 THEN       { BackSpace }
+                              BEGIN
+                               DEC(Posi);
+                               Delete(Uitg,Posi,1);
+                               DEC(InGev);
+                               ReWr;
+                              END;
+          KDelete          : BEGIN
+                              Delete(Uitg,Posi,1);
+                              DEC(InGev);
+                              ReWr;
+                             END;
+          ArrR            : IF (NOT Full) AND ((Posi-1)<InGev) THEN
+                              BEGIN
+                               INC (Posi);
+  //                             GotoXY(X+Posi-1,Y);
+                               END;
+          KInsert          : BEGIN
+                               Ins:= NOT Ins;
+                               DoCursor;
+                              END;
+          ArrL            : IF (NOT (Posi=1)) THEN
+                              BEGIN
+                               DEC (Posi);
+                              END;
+          Home            : Posi:=1;
+          KEnd            : Posi:=InGev-1;
+          CtrlY           : BEGIN
+                             Delete(Uitg,Posi,Length(Uitg)-Posi);
+                             ReWr;
+                            END;
+          CtrlT           : BEGIN
+                             Uitg[0]:=#0; Posi:=1; ReWr;
+                            END;
+    END; {Case}
+   IF EndVal=0 THEN
+    BEGIN
+     IF (CHR(Key) IN CharAllow) THEN
+      BEGIN
+       IF Posi>Len THEN
+        Posi:=Len;
+       IF (Ins=FALSE) OR Full THEN
+        BEGIN
+         IF (Length(Uitg)<Posi) THEN
+          SetLength(UitG,Posi);
+         Uitg[Posi]:=CHR(Key);
+        END
+       ELSE
+         Insert(CHR(Key),Uitg,Posi);
+       ReWr;
+       INC(Posi);
+      END;
+     END;
+    InGev:=Length(Uitg);
+   END;
+  GrInputStr:=Endval=1;
+END;
+{$ENDIF}
+
+PROCEDURE SetDefaultColor;
+
+BEGIN
+ TextColor(DefColor AND 15);
+ TextBackground(DefColor SHR 4);
+END;
+
+
+{$IFNDEF FPC}
+PROCEDURE SetCursorSize(CurDat:WORD);ASSEMBLER;
+ASM
+  mov ah,1
+  mov cx,CurDat
+  int $10
+END;
+
+{The two procedures below are standard (and os-independant) in FPC's Crt}
+PROCEDURE CursorOn;
+BEGIN
+  SetCursorSize($090A);
+END;
+
+PROCEDURE CursorOff;
+BEGIN
+  SetCursorSize($FFFF);
+END;
+
+PROCEDURE dosmemfillword(Segx,xofs,Count,Value:WORD); ASSEMBLER;
+{VAR A:WORD;
+BEGIN
+  FOR A :=0 TO Count-1 DO
+    MemW[Seg:xofs+2*A]:=Value;
+END;
+}
+ASM
+  mov  ax,segx
+  mov  es,ax
+  mov  di,xofs
+  mov  cx,count
+  mov  ax,value
+  rep
+    stosw
+end;
+
+{TYPE VetteArray=ARRAY[0..9999] OF BYTE;}
+
+PROCEDURE dosmemput(Segx,xofs:WORD;VAR Data;Count:WORD); assembler;
+{VAR A:WORD;
+    L:^VetteArray;
+BEGIN
+  L:=@Data;
+  FOR A :=0 TO Count-1 DO
+    Mem[Segx:xofs+A]:=L^[A];
+END;
+}
+asm
+  lds si,Data
+  mov ax,segx
+  mov es,ax
+  mov di,xofs
+  mov cx,count
+  rep
+    movsw
+end;
+
+PROCEDURE dosmemget(Segx,xofs:WORD;VAR Data;Count:WORD); ASSEMBLER;
+{VAR A:WORD;
+    L:^VetteArray;
+BEGIN
+  L:=@Data;
+  FOR A :=0 TO Count-1 DO
+    L^[A]:=Mem[Segx:xofs+A];
+END;
+}
+asm
+  les di,Data
+  mov ax,segx
+  mov ds,ax
+  mov si,xofs
+  mov cx,count
+  rep
+    movsw
+end;
+
+PROCEDURE FillWord(VAR Data;Count,Value:WORD); ASSEMBLER;
+{VAR A :WORD;
+    L:^VetteArray;
+BEGIN
+  L:=@Data;
+  FOR A:=0 TO Count-1 DO
+  Begin
+    L^[2*A]:=Value AND 255;
+    L^[2*A+1]:=Value shr 8;
+  END;
+END;}
+
+asm
+  les di,Data
+  mov cx,count
+  mov ax,Value
+  rep
+    movsw
+end;
+
+FUNCTION GetCursorSize:WORD;ASSEMBLER;
+ASM
+  mov ah,3
+  xor bh,bh
+  int $10
+  mov ax,cx
+END;
+
+FUNCTION  inportb(portx : word) : byte;
+BEGIN
+  Inportb:=Port[PortX];
+END;
+
+PROCEDURE outportb(portx : word;data : byte);
+BEGIN
+  Port[portx]:=Data;
+END;
+
+FUNCTION  inportw(portx : word) : word;
+BEGIN
+  Inportw:=Portw[PortX];
+END;
+
+PROCEDURE outportw(portx : word;data : word);
+BEGIN
+  PortW[portx]:=Data;
+END;
+
+ FUNCTION  inportl(portx : word) : longint; ASSEMBLER;
+ ASM
+   mov dx,portx                   { load port address }
+   db $66; in  ax,dx              { in  eax,dx }
+   db $66; mov dx,ax              { mov edx, eax }
+   db $66; shr dx,16              { shr edx, 16 }
+   { return: ax=low word, dx=hi word }
+ END;
+
+ PROCEDURE  outportl(portx : word;data : longint); ASSEMBLER;
+ ASM
+   { we cant use the 32 bit operand prefix for loading the longint -
+     therefore we have to do that in two chunks }
+     mov dx, portx
+     db $66; mov ax, Word(Data)  { mov eax, Data }
+   db $66; out dx,ax              { out dx, eax }
+ END;
+
+{$ENDIF}
+
+BEGIN
+  DefColor:=TextAttr;                { Save the current attributes, to restore}
+  Negative:=FALSE;                    { Negative=true-> better scores are lower}
+END.
+{
+  $Log$
+  Revision 1.1  2000-03-09 02:40:03  alex
+  moved files
+
+  Revision 1.6  2000/01/21 00:44:51  peter
+    * remove unused vars
+    * renamed to .pp
+
+  Revision 1.5  2000/01/14 22:03:43  marco
+   * Change Lee's first name to John :-)
+
+  Revision 1.4  2000/01/01 14:54:16  marco
+   * Added bp comtibility
+  :wq
+   * bp compat routines
+
+
+
+
+  B
+  B
+  B
+
+  Revision 1.3  1999/12/31 17:05:25  marco
+
+
+  Graphical version and fixes. BP cursorroutines moved from FPCTRIS
+
+  Revision 1.2  1999/06/11 12:51:29  peter
+    * updated for linux
+
+  Revision 1.1  1999/06/01 19:24:33  peter
+    * updates from marco
+}

install/demo/graph/gravwars.pp

@@ -0,0 +1,910 @@
+Program GravityWars;
+{A demo for TP 4.0 compability of Graph.
+
+The sources for this game was found on a site that claims to only have
+PD stuff with the below header(which was only reindented), and the webmaster
+said that everything he published was sent to him with that purpose. We tried
+to contact the authors mentioned below via mail over internet, but that
+failed. If there is somebody that claims authorship of these programs,
+please mail [email protected], and the sources will be removed from our
+websites.
+
+------------------------------------------------------------------------
+
+ORIGINAL Header:
+
+     by Sohrab Ismail-Beigi     Completed 4/23/89
+     SYSOP of The 3D Graphics BBS
+     300/1200/2400 baud, N-8-1 Full duplex
+     (201) 444-4154
+
+     Turbo Pascal 4.0 source code.  Requires VGA 640x480x16 display.
+     Note: pix=pixels in the comments}
+
+Uses Crt,Graph;
+
+Type
+    spacecraft=Record                       {used for ships and pointer}
+                 coffx,coffy,r : longint;   {center offsets and radius in pix}
+                 imagex,imagey : longint;   {upper left of image}
+                 imagepointr   : pointer;   {pointer to image data}
+                 imagesize     : word;      {size in bytes}
+               end;
+    planettype=Record
+                 cx,cy,r : longint;         {planet center and radius}
+                 d,GM    : real;            {density and G*M product}
+               end;
+
+Const
+     color : array[1..3] of byte=(Red,Green,LightBlue); {colors for planets}
+     G=0.1;                                             {gravity constant}
+     bhr=15;                                            {black hole radius}
+     Esc=#27;                                           {ASCII for Esc}
+     Return=#13;                                        { "     "  RETURN}
+
+Var
+  ship      : array[1..2] of spacecraft;    {2 ships}
+  tp,pointr : spacecraft;                   {tp is temporary, 1 pointer}
+  pl        : array[1..9] of planettype;    {the 9 planets}
+  screen    : Record                        {the game area}
+                sx,ex,sy,ey,cx,cy,lx,ly : longint; {start x/y, end x/y, center}
+              end;                                 {x/y, length x/y}
+  np,GraphDriver,GraphMode : integer;              {# of planets}
+  criticaldist : real;                             {for escape velocity calc}
+  playsong  : boolean;                             {play the songs?}
+
+Procedure Init;              {initialize everything}
+begin
+  //SetGraphBufSize(10);
+  GraphDriver:=VGA;
+  GraphMode:=VGAHi;
+  InitGraph(GraphDriver,GraphMode,'');
+  setbkcolor(black);
+  setviewport(0,0,getmaxx,getmaxy,clipoff);
+  clearviewport;
+  SetColor(LightGray);
+  SetFillStyle(SolidFill,LightGray);      {Hull of ships}
+  Circle(100,100,9);
+  FloodFill(100,100,LightGray);
+  Bar(77,98,100,102);
+  MoveTo(82,98);
+  LineRel(-3,-8);
+  LineRel(-13,0);               LineRel(0,-3);
+  LineRel(24,0);                LineRel(0,3);
+  LineRel(-7,0);                LineRel(3,8);
+  FloodFill(83,97,LightGray);
+  MoveTo(82,101);               LineRel(-3,8);
+  LineRel(-13,0);               LineRel(0,3);
+  LineRel(24,0);                LineRel(0,-3);
+  LineRel(-7,0);                LineRel(3,-8);
+  FloodFill(83,103,LightGray);
+  MoveTo(200,200);              LineRel(5,-5);
+  LineRel(5,5);                 LineRel(10,0);
+  LineRel(5,-8);                LineRel(15,0);
+  LineRel(-6,9);                LineRel(6,9);
+  LineRel(-15,0);               LineRel(-5,-7);
+  LineRel(-10,0);               LineRel(-5,5);
+  LineRel(-6,-7);               LineRel(2,-2);
+  FloodFill(201,201,LightGray);
+  SetColor(LightRed);
+  SetFillStyle(SolidFill,LightRed); {Red lights on ships}
+  Circle(100,100,2);
+  FloodFill(100,100,LightRed);
+  Bar(89,87,91,90);             Bar(89,109,91,112);
+  Bar(224,200,226,203);         Bar(240,192,242,194);
+  Bar(240,208,242,210);
+  SetColor(Yellow);
+  MoveTo(0,0);                  LineRel(0,10);
+  MoveTo(0,0);                  LineRel(10,0);
+  MoveTo(0,0);                  LineRel(15,15);   {pointer}
+  tp.imagesize:=ImageSize(0,0,16,16);     {kludge to subdue compiler bug}
+  GetMem(tp.imagepointr,tp.imagesize);
+  GetImage(0,0,16,16,tp.imagepointr^);
+  pointr.imagesize:=ImageSize(0,0,16,16);
+  GetMem(pointr.imagepointr,pointr.imagesize);
+  GetImage(0,0,16,16,pointr.imagepointr^);           {get pointer}
+  pointr.coffx:=7;
+  pointr.coffy:=7;
+  pointr.r:=9;
+  ship[1].imagesize:=ImageSize(66,87,110,113);
+  GetMem(ship[1].imagepointr,ship[1].imagesize);
+  GetImage(66,87,110,113,ship[1].imagepointr^);      {enterprise}
+  ship[1].coffx:=22; ship[1].coffy:=13; ship[1].r:=26;
+  ship[2].imagesize:=ImageSize(199,192,242,210);
+  GetMem(ship[2].imagepointr,ship[2].imagesize);
+  GetImage(199,192,242,210,ship[2].imagepointr^);     {klingon}
+  ship[2].coffx:=21; ship[2].coffy:=9; ship[2].r:=23;
+  ClearDevice;
+  screen.sx:=1;
+  screen.ex:=638;
+  screen.sy:=33;
+  screen.ey:=478;
+  screen.cx:=(screen.sx+screen.ex) div 2;                 {initialize screen}
+  screen.cy:=(screen.sy+screen.ey) div 2;                            {bounds}
+  screen.lx:=screen.ex-screen.sx+1;
+  screen.ly:=screen.ey-screen.sy+1;
+  criticaldist:=2.0*sqrt(sqr(screen.lx)+sqr(screen.ly)); {critical distance}
+  playsong:=true;                                    {for escape vel. calc}
+end;
+
+Procedure Finish;   {free memory and end}
+begin
+  FreeMem(ship[1].imagepointr,ship[1].imagesize);
+  FreeMem(ship[2].imagepointr,ship[2].imagesize);
+  FreeMem(pointr.imagepointr,pointr.imagesize);
+  FreeMem(tp.imagepointr,tp.imagesize);
+  CloseGraph;
+end;
+
+Function InBounds(cx,cy,r:longint):boolean; {is the point with radius}
+begin                                       {completely in screen bounds?}
+   InBounds:=true;
+   if r<>0 then
+     if (cx-r<=screen.sx) or (cx+r>=screen.ex) or
+        (cy-r<=screen.sy) or (cy+r>=screen.ey) then
+          InBounds:=false
+   else
+     if (cx-bhr<=screen.sx) or (cx+bhr>=screen.ex) or
+        (cy-bhr<=screen.sy) or (cy+bhr>=screen.ey) then
+          InBounds:=false;
+end;
+
+Procedure RandomSetup;   {make a random setup}
+var i,j : integer;
+    a,b : longint;
+    ok  : boolean;
+begin
+  Randomize;
+  np:=Random(9)+1;   {random # of planets 1-9}
+  for i:=1 to np do  {pick planet positions}
+    Repeat
+      ok:=true;
+      pl[i].cx:=Random(screen.lx)+screen.sx;
+      pl[i].cy:=Random(screen.ly)+screen.sy;
+      pl[i].d:=(Random(3)+2)/2.0;
+      pl[i].r:=0;
+      if Random>0.05 then pl[i].r:=Random(70)+20; {5% chance of blackhole}
+      if pl[i].r<>0 then
+        pl[i].GM:=G*2*pi*sqr(pl[i].r)*pl[i].d
+      else
+        pl[i].GM:=G*2*pi*sqr(30)*1.0;
+      ok:=InBounds(pl[i].cx,pl[i].cy,pl[i].r);
+      if (i>1) and (ok) then          {any collisions with existing planets?}
+        for j:=1 to i-1 do
+          begin
+          if sqrt(sqr(pl[i].cx-pl[j].cx)+sqr(pl[i].cy-pl[j].cy))<=
+            pl[i].r+pl[j].r+2*bhr then
+               ok:=false;
+          end;
+    Until ok;
+  for i:=1 to 2 do   {pick ship positions}
+    Repeat
+      ok:=true;
+      ship[i].imagex:=Random(screen.lx div 2)+screen.sx; {enterprise to the}
+      if i=2 then ship[2].imagex:=ship[i].imagex+screen.lx div 2; {left and}
+      ship[i].imagey:=Random(screen.ly)+screen.sy;      {klingon to the right}
+      a:=ship[i].imagex+ship[i].coffx; b:=ship[i].imagey+ship[i].coffy;
+      ok:=InBounds(a,b,ship[i].r);
+      for j:=1 to np do           {any collisions with planets?}
+        if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[i].r+bhr then
+           ok:=false;
+    Until ok;
+end;
+
+Procedure DrawSetup;  {draw current setup}
+var i,j : integer;
+begin
+  ClearDevice;
+  SetColor(White);
+  Rectangle(screen.sx-1,screen.sy-1,screen.ex-1,screen.ey-1); {game box}
+  for i:=1 to 2000 do             {2000 random stars}
+    PutPixel(Random(screen.lx)+screen.sx,Random(screen.ly)+screen.sy,White);
+  for i:=1 to 2 do  {2 ships}
+    PutImage(ship[i].imagex,ship[i].imagey,ship[i].imagepointr^,NormalPut);
+  for i:=1 to np do  {np planets}
+    if pl[i].r>0 then   {normal}
+      begin
+        SetColor(color[trunc(pl[i].d*2-1)]);
+        Circle(pl[i].cx,pl[i].cy,pl[i].r);
+        SetFillStyle(SolidFill,color[trunc(pl[i].d*2-1)]);
+        FloodFill(pl[i].cx,pl[i].cy,color[trunc(pl[i].d*2-1)]);
+      end
+    else               {black hole}
+      begin
+        SetColor(Black);
+        for j:=0 to bhr do
+          Circle(pl[i].cx,pl[i].cy,j);
+      end;
+end;
+
+Procedure ClearDialogBox;  {clear text message area}
+begin
+  SetFillStyle(SolidFill,Black);
+  Bar(0,0,screen.ex-1,screen.sy-2);
+end;
+
+Function GetString:string;  {get a string until RETURN is pressed}
+var s : string;
+    c : char;
+begin
+  s:='';
+  Repeat
+    c:=ReadKey;
+    if (c=chr(8)) and (length(s)>0) then          {backspace key}
+        begin
+          delete(s,length(s),1);
+          MoveRel(-8,0);                          {delete last char}
+          SetFillStyle(SolidFill,Black);
+          Bar(GetX,GetY,GetX+8,GetY+8);
+        end
+    else if c<>Return then
+      begin
+        s:=concat(s,c);                           {get and draw char}
+        SetColor(LightGray);
+        OutText(c);
+      end;
+  Until c=Return;
+  GetString:=s;
+end;
+
+Procedure PlayGame;
+Const number_of_explosion_dots=20;   {# dots for explosion with planet surface}
+Var vx,vy,vc,x,y,dt,ax,ay,dx,dy,dr,k : real;
+    v0,angle : array[1..2] of real;
+    s : string;
+    ch : char;
+    i,event,player,winner : integer;
+    ok,donecritical,offscreen : boolean;
+    buffer : array[1..number_of_explosion_dots] of Record  {for explosion}
+                                                     x,y,color : integer;
+                                                   end;
+begin
+  v0[1]:=0; v0[2]:=0; angle[1]:=0; angle[2]:=0;
+  player:=1;
+  donecritical:=false;
+  Repeat                               {infinite loop}
+    ClearDialogBox;
+    SetColor(LightGray);
+    str(player,s);
+    s:=concat('Player ',s);        {player #}
+    OutTextXY(0,0,s);
+    Repeat                         {get angle}
+      MoveTo(0,10);
+      str(angle[player]:3:5,s);
+      s:=concat('Angle: [',s,']: ');
+      OutText(s);
+      s:=GetString;
+      if (s[1]='Q') or (s[1]='q') then exit;
+      i:=0;
+      if s<>'' then Val(s,angle[player],i);
+      SetFillStyle(SolidFill,Black);
+      ok:=(i=0) and (angle[player]>=0.0) and (angle[player]<=360);
+      if not ok then Bar(0,10,screen.ex-1,18);
+    Until ok;
+    Repeat                        {get initial velocity}
+      MoveTo(0,20);
+      str(v0[player]:2:5,s);
+      s:=concat('Initial Velocity: [',s,']: ');
+      OutText(s);
+      s:=GetString;
+      if (s[1]='Q') or (s[1]='q') then exit;
+      i:=0;
+      if s<>'' then Val(s,v0[player],i);
+      SetFillStyle(SolidFill,Black);
+      ok:=(i=0) and (v0[player]>=0.0) and (v0[player]<=10.0);
+      if not ok then Bar(0,20,screen.ex-1,28);
+    Until ok;
+    k:=pi*angle[player]/180.0;   {angle in radians}
+    vx:=v0[player]*cos(k);
+    vy:=-v0[player]*sin(k);
+    x:=ship[player].imagex+ship[player].coffx+ship[player].r*cos(k);
+    y:=ship[player].imagey+ship[player].coffy-ship[player].r*sin(k);
+    ClearDialogBox;
+    MoveTo(round(x),round(y));
+    SetColor(White);
+    offscreen:=false;
+    Repeat                       {calculate and draw trajectory}
+      dt:=0.25;                  {time interval [vel. is in pix/time]}
+      x:=x+vx*dt; y:=y+vy*dt;
+      ax:=0; ay:=0;
+      for i:=1 to np do          {calc accel. due to gravity}
+        begin
+          dx:=x-pl[i].cx; dy:=y-pl[i].cy; dr:=sqrt(sqr(dx)+sqr(dy));
+          k:=1/(sqr(dr)*dr);
+          if pl[i].r<>0 then       {normal}
+            begin
+              ax:=ax-pl[i].GM*dx*k;
+              ay:=ay-pl[i].GM*dy*k
+            end
+          else                     {black hole}
+            begin
+              ax:=ax-pl[i].GM*dx*(k+sqr(k*dr));
+              ay:=ay-pl[i].GM*dy*(k+sqr(k*dr));
+            end;
+        end;
+      vx:=vx+ax*dt; vy:=vy+ay*dt;
+      event:=0;
+      if keypressed then
+        event:=1
+      else if (x>=screen.sx) and (x<=screen.ex) and        {in screen bounds?}
+              (y>=screen.sy) and (y<=screen.ey) then
+         begin
+           donecritical:=false;
+           i:=GetPixel(round(x),round(y));
+           if (i=color[1]) or (i=color[2]) or (i=color[3]) or
+              (i=LightRed) or (i=LightGray) then event:=2
+           else
+             if offscreen then
+               MoveTo(round(x),round(y))
+             else
+               LineTo(round(x),round(y));
+           offscreen:=false;
+         end                                               {off screen}
+      else if not donecritical then
+        begin
+          offscreen:=true;               {offscreen and critical distance}
+          dx:=x-screen.cx; dy:=y-screen.cy; dr:=sqrt(sqr(dx)+sqr(dy));
+          if dr>=criticaldist then
+            begin
+              vc:=(dx*vx+dy*vy)/dr;
+              k:=0; for i:=1 to np do k:=k+pl[i].GM;
+              if 0.5*sqr(vc)>=k/dr then     {do we have escape velocity?}
+                event:=3;
+            end;
+        end;
+    Until event<>0;
+    if event=1 then          {a key was pressed for a break}
+      begin
+        ClearDialogBox;
+        ch:=ReadKey; {one already in buffer}
+        SetColor(LightGray);
+        OutTextXY(0,0,'Break... Esc to break, any other key to continue');
+        ch:=ReadKey;
+        if ch=Esc then exit;
+      end
+    else if event=3 then       {missile escaped the universe}
+      begin
+        ClearDialogBox;
+        SetColor(LightGray);
+        OutTextXY(0,0,'Missile left the galaxy...');
+        delay(2000);
+      end
+    else           {event=2}   {hit something}
+      begin
+        if (i=color[1]) or (i=color[2]) or (i=color[3]) then  {hit a planet}
+          begin
+            for i:=1 to number_of_explosion_dots do     {draw explosion}
+              begin
+                buffer[i].x:=trunc(x+20*(Random-0.5));
+                buffer[i].y:=trunc(y+20*(Random-0.5));
+                buffer[i].color:=GetPixel(buffer[i].x,buffer[i].y);
+                PutPixel(buffer[i].x,buffer[i].y,LightRed);
+                delay(25);
+              end;
+            delay(1000);
+            for i:=1 to number_of_explosion_dots do     {erase explosion}
+              PutPixel(buffer[i].x,buffer[i].y,buffer[i].color);
+          end
+        else    {hit a ship!}
+          begin
+            if sqrt(sqr(x-ship[1].imagex-ship[1].coffx)+ {which one won?}
+                    sqr(y-ship[1].imagey-ship[1].coffy))<=ship[1].r+5 then
+                      winner:=2
+            else winner:=1;
+            for event:=1 to 100 do          {flash the screen}
+              SetPalette(Black,Random(16));
+            SetPalette(Black,Black);
+            for i:=1 to 1000 do    {put some white and red points}
+              begin
+                k:=Random*2*pi;
+                event:=Random(3);
+                if event=0 then
+                  PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Black)
+                else if event=1 then
+                  PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Red)
+                else
+                  PutPixel(trunc(x+20*Random*cos(k)),trunc(y+20*Random*sin(k)),White);
+              end;
+            ClearDialogBox;
+            SetColor(LightGray);
+            str(winner,s);
+            s:=concat('Player ',s,' wins!!!');    {announce}
+            OutTextXY(0,0,s);
+            if playsong then                      {play a tune}
+              begin
+                Sound(440); delay(150);
+                Nosound; delay(50);
+                Sound(440); delay(150);
+                Sound(554); delay(150);
+                Sound(659); delay(350);
+                Sound(554); delay(150);
+                Sound(659); delay(450);
+                Nosound; delay(500);
+                Sound(880); delay(800);
+                Nosound;
+              end;
+            delay(3000);
+            exit;
+          end;
+      end; {if event=3}
+    Inc(player); if player=3 then player:=1;    {next player}
+  Until true=false; {infinite loop}
+end;
+
+Procedure PlayingtheGame;     {playing the game menu}
+var option : char;
+begin
+  Repeat
+    ClearDialogBox;
+    SetColor(LightGray);
+    OutTextXY(0,0,'1. Random setup   2. Play game    Esc quits menu');
+    OutTextXY(0,10,'Option: ');
+    option:=ReadKey;
+    Case option of
+      '1' : begin
+              ClearDialogBox;
+              RandomSetup;
+              DrawSetup;
+            end;
+      '2' : PlayGame;
+    end;
+  Until option=Esc;
+end;
+
+Procedure Options;   {options menu}
+var option : char;
+begin
+  Repeat
+    ClearDialogBox;
+    SetColor(LightGray);
+    OutTextXY(0,0,'1. Redraw screen   2. Sound on/off     Esc quits menu');
+    OutTextXY(0,10,'Option: ');
+    option:=ReadKey;
+    Case option of
+      '1' : DrawSetUp;
+      '2' : playsong:=not playsong;
+    end;
+  Until option=Esc;
+end;
+
+Procedure InterpKey(c:char; var x,y,coffx,coffy,r:longint;
+                            var jump:integer; var moveit:boolean);
+begin              {interprets keys for movement of pointer, mainly to save}
+  Case c of                {space due to shared code in many Change routines}
+    '+' : if jump<49 then Inc(jump,2);
+    '-' : if jump>2 then Dec(jump,2);
+    '8' : begin                              {up}
+            Dec(y,jump);
+            if InBounds(x+coffx,y+coffy,r) then
+              moveit:=true
+            else
+              Inc(y,jump);
+          end;
+    '2' : begin                              {down}
+            Inc(y,jump);
+            if InBounds(x+coffx,y+coffy,r) then
+              moveit:=true
+            else
+              Dec(y,jump);
+          end;
+    '4' : begin                              {left}
+            Dec(x,jump);
+            if InBounds(x+coffx,y+coffy,r) then
+              moveit:=true
+            else
+              Inc(x,jump);
+          end;
+    '6' : begin                              {right}
+            Inc(x,jump);
+            if InBounds(x+coffx,y+coffy,r) then
+              moveit:=true
+            else
+              Dec(x,jump);
+          end;
+  end; {case c of}
+end;
+
+Procedure MoveShip;    {move a given ship to a new legal position}
+var c : char;
+    s,jump,j : integer;
+    x,y,xold,yold,a,b : longint;
+    legal,moveit : boolean;
+begin
+  ClearDialogBox;
+  SetColor(LightGray);
+  OutTextXY(0, 0,'Ships:  1. Enterprise   2. Klingon    Esc aborts');
+  OutTextXY(0,10,'Which ship? ');     {get the proper ship}
+  Repeat
+    c:=ReadKey;
+  Until (c='1') or (c='2') or (c=Esc);
+  if c=Esc then exit;
+  if c='1' then s:=1 else s:=2;
+  ClearDialogBox;
+  OutTextXY(0, 0,'Use cursors to move ship. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to place, + and - to change size of jumps.');
+  jump:=30;
+  x:=ship[s].imagex; y:=ship[s].imagey;
+  Repeat    {loop until Esc or somewhere legal}
+    Repeat    {loop until Esc or RETURN}
+      Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                               (c='+') or (c='-') or (c=Return) or (c=Esc);
+      moveit:=false; xold:=x; yold:=y;
+      InterpKey(c,x,y,ship[s].coffx,ship[s].coffy,ship[s].r,jump,moveit);
+      if moveit then  {if can move the image,}
+        begin
+          PutImage(xold,yold,ship[s].imagepointr^,XORPut); {erase old}
+          PutImage(x,y,ship[s].imagepointr^,XORPut);       {draw new}
+          moveit:=false;
+        end;
+    Until (c=Return) or (c=Esc);
+    if c=Esc then                     {abort}
+      begin
+        PutImage(x,y,ship[s].imagepointr^,XORPut);
+        PutImage(ship[s].imagex,ship[s].imagey,ship[s].imagepointr^,NormalPut);
+        exit;
+      end;
+    a:=x+ship[s].coffx; b:=y+ship[s].coffy;
+    legal:=InBounds(a,b,ship[s].r);     {in bounds?}
+    for j:=1 to np do                   {in collision with any planets?}
+      if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[s].r+bhr then
+         legal:=false;
+    if not legal then                   {oops! not legal!}
+      begin
+        SetPalette(Black,White);
+        SetFillStyle(SolidFill,Black);
+        Bar(0,20,screen.ex,screen.sy-2);
+        delay(100);
+        SetPalette(Black,Black);
+        SetColor(LightGray);
+        OutTextXY(0,20,'Illegal ship position!');
+      end;
+  Until legal;
+  ship[s].imagex:=x; ship[s].imagey:=y;    {ok, place it there}
+end;
+
+Procedure MovePlanet;   {move a planet}
+var c : char;
+    i,p,jump : integer;
+    x,y,xold,yold,minr,t,cxorig,cyorig : longint;
+    moveit,legal : boolean;
+begin
+  ClearDialogBox;
+  if np=0 then         {no planets!}
+    begin
+      OutTextXY(0,0,'No planets to move!');
+      delay(2000);
+      exit;
+    end;
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
+  jump:=30;
+  x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
+  Repeat    {loop until Esc or RETURN}
+    Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                             (c='+') or (c='-') or (c=Return) or (c=Esc);
+    moveit:=false; xold:=x; yold:=y;
+    InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+    if moveit then
+      begin
+        PutImage(xold,yold,pointr.imagepointr^,XORPut);
+        PutImage(x,y,pointr.imagepointr^,XORPut);
+        moveit:=false;
+      end;
+  Until (c=Return) or (c=Esc);
+  PutImage(x,y,pointr.imagepointr^,XORPut);   {erase pointer}
+  if c=Esc then exit;
+  p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
+  for i:=1 to np do   {find the closest planet/black hole}
+    begin
+      t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
+      if t<minr then begin minr:=t; p:=i; end;
+    end;
+  SetColor(LightGreen);                      {clear it out}
+  Circle(pl[p].cx,pl[p].cy,pl[p].r);
+  SetFillStyle(SolidFill,Black);
+  FloodFill(pl[p].cx,pl[p].cy,LightGreen);
+  SetColor(Black);
+  Circle(pl[p].cx,pl[p].cy,pl[p].r);
+  ClearDialogBox;
+  SetColor(LightGray);
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to place planet center, + - change size of jumps.');
+  jump:=30;
+  x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
+  cxorig:=pl[p].cx; cyorig:=pl[p].cy;   {save them as they may change later}
+  Repeat    {loop until Esc or legal position}
+    Repeat
+      Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                               (c='+') or (c='-') or (c=Return) or (c=Esc);
+      moveit:=false; xold:=x; yold:=y;
+      InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+      if moveit then
+        begin
+          PutImage(xold,yold,pointr.imagepointr^,XORPut);
+          PutImage(x,y,pointr.imagepointr^,XORPut);
+          moveit:=false;
+        end;
+    Until (c=Return) or (c=Esc);
+    legal:=true;
+    if c<>Esc then    {ok, RETURN pressed}
+      begin
+        pl[p].cx:=-1000; pl[p].cy:=-1000;  {so it won't collide with itself!}
+        for i:=1 to np do   {any collisions with other planets?}
+          if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+pl[p].r+2*bhr then
+            legal:=false;
+        for i:=1 to 2 do    {any collisions with other ships?}
+          if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
+                  sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
+             then legal:=false;
+      end;
+    if not legal then      {oops!}
+      begin
+        SetPalette(Black,White);
+        SetFillStyle(SolidFill,Black);
+        Bar(0,20,screen.ex,screen.sy-2);
+        delay(100);
+        SetPalette(Black,Black);
+        SetColor(LightGray);
+        OutTextXY(0,20,'Illegal planet position!');
+      end;
+  Until legal;
+  pl[p].cx:=x; pl[p].cy:=y; {put it there}
+  if c=Esc then             {abort and restore}
+    begin
+      pl[p].cx:=cxorig;
+      pl[p].cy:=cyorig;
+    end;
+  DrawSetUp;                {redraw screen}
+end;
+
+Procedure MakePlanet;       {make a planet given center and radius}
+var c : char;
+    i,p,jump : integer;
+    x,y,xold,yold : longint;
+    moveit,legal : boolean;
+begin
+  ClearDialogBox;
+  if np=9 then       {too many planets already!}
+    begin
+      OutTextXY(0,0,'Can not make any more planets!');
+      delay(2000);
+      exit;
+    end;
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to place center, + and - to change size of jumps.');
+  jump:=30;
+  x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
+  Repeat   {loop until a legal center is picked or Esc}
+    Repeat
+      Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                               (c='+') or (c='-') or (c=Return) or (c=Esc);
+      moveit:=false; xold:=x; yold:=y;
+      InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+      if moveit then
+        begin
+          PutImage(xold,yold,pointr.imagepointr^,XORPut);
+          PutImage(x,y,pointr.imagepointr^,XORPut);
+          moveit:=false;
+        end;
+    Until (c=Return) or (c=Esc);
+    if c=Esc then exit;
+    legal:=true;
+    for i:=1 to np do    {any collisions with planets?}
+      if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+2*bhr then
+        legal:=false;
+    for i:=1 to 2 do     {any collisions with ships?}
+      if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
+              sqr(y-ship[i].imagey-ship[i].coffy))<=ship[i].r+bhr
+         then legal:=false;
+    if not legal then                    {uh oh!}
+      begin
+        SetPalette(Black,White);
+        SetFillStyle(SolidFill,Black);
+        Bar(0,20,screen.ex,screen.sy-2);
+        delay(100);
+        SetPalette(Black,Black);
+        SetColor(LightGray);
+        OutTextXY(0,20,'Illegal planet center!');
+      end;
+  Until legal;
+  p:=np+1; pl[p].cx:=x; pl[p].cy:=y;   {ok, store the info}
+  ClearDialogBox;
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to radius, + and - change size of jumps.');
+  jump:=30;
+  Repeat     {loop until a legal radius is entered or Esc}
+    Repeat
+      Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                               (c='+') or (c='-') or (c=Return) or (c=Esc);
+      moveit:=false; xold:=x; yold:=y;
+      InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+      if moveit then
+        begin
+          PutImage(xold,yold,pointr.imagepointr^,XORPut);
+          PutImage(x,y,pointr.imagepointr^,XORPut);
+          moveit:=false;
+        end;
+    Until (c=Return) or (c=Esc);
+    if c=Esc then exit;
+    legal:=true;
+    pl[p].r:=round(sqrt(sqr(x-pl[p].cx)+sqr(y-pl[p].cy))); {find radius}
+    for i:=1 to np do    {planet collisions?}
+      if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[p].r+pl[i].r+2*bhr then
+        legal:=false;
+    for i:=1 to 2 do     {ship collisions?}
+      if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
+              sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
+         then legal:=false;
+    if not legal then    {oh no!}
+      begin
+        SetPalette(Black,White);
+        SetFillStyle(SolidFill,Black);
+        Bar(0,20,screen.ex,screen.sy-2);
+        delay(100);
+        SetPalette(Black,Black);
+        SetColor(LightGray);
+        OutTextXY(0,20,'Illegal planet radius!');
+      end;
+  Until legal;
+  PutImage(x,y,pointr.imagepointr^,XORPut); {kill the pointer}
+  Inc(np);    {actually add the new planet info}
+  pl[p].d:=1.0; pl[p].GM:=G*2*pi*sqr(pl[p].r)*1.0; {initialize it}
+  SetColor(color[1]);                      {draw it}
+  Circle(pl[p].cx,pl[p].cy,pl[p].r);
+  SetFillStyle(SolidFill,color[1]);
+  FloodFill(pl[p].cx,pl[p].cy,color[1]);
+end;
+
+Procedure ChangePlanet;   {change density [color] of a planet}
+var c : char;               {will not change black holes}
+    i,p,jump : integer;
+    x,y,xold,yold,minr,t : longint;
+    moveit,legal : boolean;
+begin
+  ClearDialogBox;
+  legal:=false;
+  if np>0 then             {see if any non-black holes exist}
+    for i:=1 to np do
+      if pl[i].r<>0 then legal:=true;
+  if (np=0) or (not legal) then   {sorry!}
+    begin
+      OutTextXY(0,0,'No planets to change!');
+      delay(2000);
+      exit;
+    end;
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
+  jump:=30;
+  x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
+  Repeat   {repeat until RETURN or Esc}
+    Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                             (c='+') or (c='-') or (c=Return) or (c=Esc);
+    moveit:=false; xold:=x; yold:=y;
+    InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+    if moveit then
+      begin
+        PutImage(xold,yold,pointr.imagepointr^,XORPut);
+        PutImage(x,y,pointr.imagepointr^,XORPut);
+        moveit:=false;
+      end;
+  Until (c=Return) or (c=Esc);
+  PutImage(x,y,pointr.imagepointr^,XORPut);  {kill the pointer}
+  if c=Esc then exit;
+  p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
+  for i:=1 to np do   {find closest non-black hole planet}
+    begin
+      t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
+      if (t<minr) and (pl[i].r<>0) then begin minr:=t; p:=i; end;
+    end;
+  ClearDialogBox;
+  OutTextXY(0, 0,'Change to: 1. Red   2. Green   3. Blue    Esc aborts');
+  OutTextXY(0,10,'Option: ');    {get a density}
+  Repeat c:=ReadKey; Until (c='1') or (c='2') or (c='3') or (c=Esc);
+  if c=Esc then exit;
+  i:=Ord(c)-48;
+  pl[p].d:=(i+1)/2.0;       {new density}
+  SetColor(color[i]);       {redraw}
+  Circle(pl[p].cx,pl[p].cy,pl[p].r);
+  SetFillStyle(SolidFill,color[i]);
+  FloodFill(pl[p].cx,pl[p].cy,color[i]);
+end;
+
+Procedure DeletePlanet;   {kill a planet/black hole}
+var c : char;
+    i,p,jump : integer;
+    x,y,xold,yold,minr,t : longint;
+    moveit : boolean;
+begin
+  ClearDialogBox;
+  if np=0 then    {nobody there!}
+    begin
+      OutTextXY(0,0,'No planets to delete!');
+      delay(2000);
+      exit;
+    end;
+  OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
+  OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
+  jump:=30;
+  x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
+  Repeat
+    Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
+                             (c='+') or (c='-') or (c=Return) or (c=Esc);
+    moveit:=false; xold:=x; yold:=y;
+    InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
+    if moveit then
+      begin
+        PutImage(xold,yold,pointr.imagepointr^,XORPut);
+        PutImage(x,y,pointr.imagepointr^,XORPut);
+        moveit:=false;
+      end;
+  Until (c=Return) or (c=Esc);
+  PutImage(x,y,pointr.imagepointr^,XORPut);
+  if c=Esc then exit;
+  p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
+  for i:=1 to np do  {find the closest planet/black hole}
+    begin
+      t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
+      if t<minr then begin minr:=t; p:=i; end;
+    end;
+  if p<9 then           {move everybody above the one deleted one down}
+    for i:=p to np-1 do
+      pl[i]:=pl[i+1];
+  Dec(np);         {delete}
+  DrawSetup;       {redraw}
+end;
+
+Procedure Changes;   {changes menu}
+var option : char;
+begin
+  Repeat
+    ClearDialogBox;
+    SetColor(LightGray);
+    OutTextXY(0, 0,'1. Move ship       2. Move planet    3. Make planet');
+    OutTextXY(0,10,'4. Change planet   5. Delete planet     Esc quits menu');
+    OutTextXY(0,20,'Option: ');
+    option:=ReadKey;
+    Case option of
+      '1' : MoveShip;
+      '2' : MovePlanet;
+      '3' : MakePlanet;
+      '4' : ChangePlanet;
+      '5' : DeletePlanet;
+    end;
+  Until option=Esc;
+end;
+
+Procedure MainMenu;   {main menu}
+var option : char;
+begin
+  Repeat
+    ClearDialogBox;
+    SetColor(LightGray);
+    OutTextXY(0,0,'1. Playing the game   2. Options   3. Changes   4. Quit');
+    OutTextXY(0,10,'Option: ');
+    option:=ReadKey;
+    Case option of
+      '1' : PlayingtheGame;
+      '2' : Options;
+      '3' : Changes;
+    end;
+  Until option='4';
+end;
+
+Procedure Title;   {title screen and credits}
+begin
+  SetTextStyle(SansSerifFont,HorizDir,9);
+  OutTextXY(25,100,'Gravity Wars');
+  SetTextStyle(SansSerifFont,HorizDir,2);
+  OutTextXY(300,300,'by Sohrab Ismail-Beigi');
+  delay(3000);
+  SetTextStyle(DefaultFont,HorizDir,0);
+end;
+
+BEGIN
+  Init;
+  Title;
+  RandomSetup;
+  DrawSetup;
+  MainMenu;
+  Finish;
+END.

install/demo/graph/mandel.pp

@@ -0,0 +1,356 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993-98 by Gernot Tenchio
+
+    Mandelbrot Example using the Graph unit
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program mandel;
+
+{
+  Mandelbrot example using the graph unit.
+
+  Note: For linux you need to run this program as root !!
+}
+
+uses
+{$ifdef go32v2}
+  dpmiexcp,
+{$endif go32v2}
+  dos,Graph;
+
+{
+const
+  shift:byte=12;
+}
+
+var
+  SearchPoint,ActualPoint,NextPoint       : PointType;
+  LastColor                              : longint;
+  Gd,Gm,
+  Max_Color,Max_X_Width,
+  Max_Y_Width,Y_Width                    : word;
+  Y1,Y2,X1,X2,Dy,Dx                      : Real;
+  Zm                                     : Integer;
+  SymetricCase                                   : boolean;
+  LineY                                  : array [0..600] OF BYTE;
+  LineX                                  : array [0..100,0..600] OF INTEGER;
+const
+    SX : array [0..7] OF SHORTINT=(-1, 0, 1, 1, 1, 0,-1,-1);
+    SY : array [0..7] OF SHORTINT=(-1,-1,-1, 0, 1, 1, 1, 0);
+type
+    arrayType = array[1..50] of integer;
+
+{------------------------------------------------------------------------------}
+  function ColorsEqual(c1, c2 : longint) : boolean;
+    begin
+       ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or
+         ((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
+         ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
+         ((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
+    end;
+
+{------------------------------------------------------------------------------}
+function CalcMandel(Point:PointType; z:integer) : Longint ;
+var
+  x,y,xq,yq,Cx,Cy : real ;
+begin
+  Cy:=y2 + dy*Point.y ;
+  Cx:=x2 + dx*Point.x ;
+  X:=-Cx ; Y:=-Cy ;
+  repeat
+    xq:=x * x;
+    yq:=y * y  ;
+    y :=x * y;
+    y :=y + y - cy;
+    x :=xq - yq - cx ;
+    z :=z -1;
+  until (Z=0) or (Xq + Yq > 4 );
+  if Z=0 Then
+    CalcMandel:=(blue and $FFFFFF)
+  else
+    CalcMandel:=(z mod Max_Color) + 1 ;
+end;
+
+{-----------------------------------------------------------------------------}
+procedure Partition(var A : arrayType; First, Last : Byte);
+var
+  Right,Left : byte ;
+  V,Temp     : integer;
+begin
+    V := A[(First + Last) SHR 1];
+    Right := First;
+    Left := Last;
+    repeat
+      while (A[Right] < V) do
+        inc(Right);
+      while (A[Left] > V) do
+        Dec(Left);
+      if (Right <= Left) then
+        begin
+          Temp:=A[Left];
+          A[Left]:=A[Right];
+          A[Right]:=Temp;
+          Right:=Right+1;
+          Left:=Left-1;
+        end;
+    until Right > Left;
+    if (First < Left) then
+      Partition(A, First, Left);
+    if (Right < Last) then
+      Partition(A, Right, Last)
+end;
+
+{-----------------------------------------------------------------------------}
+function BlackScan(var NextPoint:PointType) : boolean;
+begin
+  BlackScan:=true;
+  repeat
+    if NextPoint.X=Max_X_Width then
+      begin
+        if NextPoint.Y < Y_Width then
+          begin
+            NextPoint.X:=0 ;
+            NextPoint.Y:=NextPoint.Y+1;
+          end
+        else
+          begin
+            BlackScan:=false;
+            exit;
+          end ; { IF }
+      end ; { IF }
+    NextPoint.X:=NextPoint.X+1;
+  until GetPixel(NextPoint.X,NextPoint.Y)=0;
+end ;
+
+{------------------------------------------------------------------------------}
+procedure Fill(Ymin,Ymax,LastColor:integer);
+var
+ P1,P3,P4,P    : integer ;
+ Len,P2        : byte ;
+ Darray        : arraytype;
+begin
+  SetColor(LastColor);
+  for P1:=Ymin+1 to Ymax-1 do
+   begin
+     Len:=LineY[P1] ;
+     if Len >= 2 then
+      begin
+        for P2:=1 to Len do
+          Darray[P2]:=LineX[P2,P1] ;
+        if Len > 2 then
+          Partition(Darray,1,len);
+        P2:=1;
+        repeat
+          P3:= Darray[P2] ; P4:= Darray[P2 + 1];
+          if P3 <> P4 then
+           begin
+             line ( P3 , P1 , P4 , P1) ;
+             if SymetricCase then
+              begin
+                P:=Max_Y_Width-P1;
+                line ( P3 , P , P4 , P ) ;
+              end;
+           end; { IF }
+          P2:=P2+2;
+        until P2 >= Len ;
+      end; { IF }
+   end; { FOR }
+end;
+
+{-----------------------------------------------------------------------------}
+Function NewPosition(Last:Byte):Byte;
+begin
+  newposition:=(((last+1) and 254)+6) and 7;
+end;
+
+{-----------------------------------------------------------------------------}
+procedure CalcBounds;
+var
+  lastOperation,KK,
+  Position                     : Byte ;
+  foundcolor                   : longint;
+  Start,Found,NotFound         : boolean ;
+  MerkY,Ymax                   : Integer ;
+label
+  L;
+begin
+  repeat
+    FillChar(LineY,SizeOf(LineY),0) ;
+    ActualPoint:=NextPoint;
+    LastColor:=CalcMandel(NextPoint,Zm) ;
+    putpixel (ActualPoint.X,ActualPoint.Y,LastColor);
+    if SymetricCase then
+      putpixel (ActualPoint.X,Max_Y_Width-ActualPoint.Y,LastColor) ;
+    Ymax:=NextPoint.Y ;
+    MerkY:=NextPoint.Y ;
+    NotFound:=false ;
+    Start:=false ;
+    LastOperation:=4 ;
+    repeat
+      Found:=false ;
+      KK:=0 ;
+      Position:=NewPosition(LastOperation);
+      repeat
+        LastOperation:=(Position+KK) and 7 ;
+        SearchPoint.X:=ActualPoint.X+Sx[LastOperation];
+        SearchPoint.Y:=ActualPoint.Y+Sy[LastOperation];
+        if ((SearchPoint.X < 0) or
+            (SearchPoint.X > Max_X_Width) or
+            (SearchPoint.Y < NextPoint.Y) or
+            (SearchPoint.Y > Y_Width)) then
+          goto L;
+        if (SearchPoint.X=NextPoint.X) and (SearchPoint.Y=NextPoint.Y) then
+          begin
+            Start:=true ;
+            Found:=true ;
+          end
+        else
+          begin
+            FoundColor:=GetPixel(SearchPoint.X,SearchPoint.Y) ;
+            if FoundColor = 0 then
+              begin
+                FoundColor:= CalcMandel (SearchPoint,Zm) ;
+                Putpixel (SearchPoint.X,SearchPoint.Y,FoundColor) ;
+                if SymetricCase then
+                  PutPixel (SearchPoint.X,Max_Y_Width-SearchPoint.Y,FoundColor) ;
+              end ;
+            if ColorsEqual(FoundColor,LastColor) then
+              begin
+                if ActualPoint.Y <> SearchPoint.Y then
+                  begin
+                    if SearchPoint.Y = MerkY then
+                      LineY[ActualPoint.Y]:=LineY[ActualPoint.Y]-1;
+                    MerkY:= ActualPoint.Y ;
+                    LineY[SearchPoint.Y]:=LineY[SearchPoint.Y]+1;
+                  end ;
+                LineX[LineY[SearchPoint.Y],SearchPoint.Y]:=SearchPoint.X ;
+                if SearchPoint.Y > Ymax then Ymax:= SearchPoint.Y ;
+                  Found:=true ;
+                ActualPoint:=SearchPoint ;
+              end;
+L:
+            KK:=KK+1;
+            if KK > 8 then
+              begin
+                Start:=true ;
+                NotFound:=true ;
+              end;
+          end;
+      until Found or (KK > 8);
+    until Start ;
+    if not NotFound then
+      Fill(NextPoint.Y,Ymax,LastColor) ;
+  until not BlackScan(NextPoint);
+end ;
+
+
+{------------------------------------------------------------------------------
+                              MAINROUTINE
+------------------------------------------------------------------------------}
+  var
+     error : word;
+
+var neededtime,starttime : longint;
+  hour, minute, second, sec100 : word;
+const
+{$ifdef win32}
+  gmdefault : word = m640x480x16;
+{$else not win32}
+  {$ifdef Linux}
+   gmdefault : word = g640x480x256;
+  {$else}
+   gmdefault : word = m640x480x256;
+  {$endif}
+{$endif win32}
+
+begin
+  if paramcount>0 then
+    begin
+       val(paramstr(1),gm,error);
+       if error<>0 then
+         gm:=gmdefault;
+    end
+  else
+    gm:=gmdefault;
+  gd:=detect;
+  GetTime(hour, minute, second, sec100);
+  starttime:=((hour*60+minute)*60+second)*100+sec100;
+  InitGraph(gd,gm,'');
+  if GraphResult <> grOk then
+    begin
+      Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
+      Halt(1);
+    end;
+  Max_X_Width:=GetMaxX;
+  Max_y_Width:=GetMaxY;
+  Max_Color:=GetMaxColor-1;
+  ClearViewPort;
+
+  x1:=-0.9;
+  x2:= 2.2;
+  y1:= 1.25;
+  y2:=-1.25;
+  zm:=90;
+  dx:=(x1 - x2) / Max_X_Width ;
+  dy:=(y1 - y2) / Max_Y_Width ;
+  if abs(y1) = abs(y2) then
+   begin
+     SymetricCase:=true;
+     Y_Width:=Max_Y_Width shr 1
+   end
+  else
+   begin
+     SymetricCase:=false;
+     Y_Width:=Max_Y_Width;
+   end;
+  NextPoint.X:=0;
+  NextPoint.Y:=0;
+  LastColor:=CalcMandel(SearchPoint,zm);
+  CalcBounds ;
+  GetTime(hour, minute, second, sec100);
+  neededtime:=((hour*60+minute)*60+second)*100+sec100-starttime;
+{$ifndef fpc_profile}
+  readln;
+{$endif fpc_profile}
+  CloseGraph;
+  Writeln('Mandel took ',Real(neededtime)/100:0:3,' secs to generate mandel graph');
+  Writeln('With graph driver ',gd,' and graph mode ',gm);
+end.
+{
+  $Log$
+  Revision 1.1  2000-03-09 02:40:04  alex
+  moved files
+
+  Revision 1.10  2000/03/08 22:32:41  alex
+  fixed warnings about type conversion
+
+  Revision 1.9  2000/02/22 03:43:55  alex
+  fixed the warning
+
+  Revision 1.8  2000/01/04 15:29:42  marco
+   * fixed constants for graphmodes
+
+  Revision 1.7  1999/12/22 14:36:07  jonas
+    * changed type of max_color to word so it works now with 16bit color modes
+      (thanks to Arjan van Dijk for noticing the problem)
+
+  Revision 1.6  1999/12/14 22:59:52  pierre
+   * adapted to new graph unit
+
+  Revision 1.5  1999/05/27 21:36:33  peter
+    * new demo's
+    * fixed mandel for linux
+
+  Revision 1.4  1998/12/20 22:22:10  peter
+    * updates
+
+}

install/demo/graph/maze.pp

@@ -0,0 +1,478 @@
+{A demo with some interesting algoritms, and for Graph.
+
+The sources for this game was found on a site that claims to only have
+PD stuff with the below header(which was only reindented), and the webmaster
+said that everything he published was sent to him with that purpose. We tried
+to contact the authors mentioned below via mail over internet, but that
+failed. If there is somebody that claims authorship of these programs,
+please mail [email protected], and the sources will be removed from our
+websites.
+
+------------------------------------------------------------------------
+
+ORIGINAL Header:
+
+created by Randy Ding July 16,1983   <April 21,1992>
+
+Very small FPC fixes by Marco van de Voort (EgaHi to vgahi), and tried
+setting the maze dimensions maxx and maxy to a bigger size.
+Won't work, you'll have to update all vars to al least word to increase the
+complexity of the grid further. I didn't do it, since 200x200 is already
+unreadable to me.
+
+Don't forget the BGIPATH of InitGraph.
+}
+
+{$R-}   { range checking }
+
+program makemaze;
+
+uses
+  crt, graph;
+
+const
+  screenwidth   = 640;
+  screenheight  = 480;
+  minblockwidth = 2;
+  maxx = 200;   { BP: [3 * maxx * maxy] must be less than 65520 (memory segment) }
+                { FPC: Normally no problem. ( even if you'd use 1600x1200x3< 6MB)}
+  maxy = 200;   { here maxx/maxy about equil to screenwidth/screenheight }
+  flistsize = maxx*maxy DIV 2; { flist size (fnum max, about 1/3 of maxx * maxy) }
+
+  background = black;
+  gridcolor  = green;
+  solvecolor = white;
+
+  rightdir = $01;
+  updir    = $02;
+  leftdir  = $04;
+  downdir  = $08;
+
+  unused   = $00;    { cell types used as flag bits }
+  frontier = $10;
+{  reserved = $20; }
+  tree     = $30;
+
+
+type
+  frec = record
+          column, row : byte;
+         end;
+  farr = array [1..flistsize] of frec;
+
+  cellrec = record
+              point : word;  { pointer to flist record }
+              flags : byte;
+            end;
+  cellarr = array [1..maxx,1..maxy] of cellrec;
+
+  {
+    one byte per cell, flag bits...
+
+    0: right, 1 = barrier removed
+    1: top    "
+    2: left   "
+    3: bottom "
+    5,4: 0,0 = unused cell type
+         0,1 = frontier "
+         1,1 = tree     "
+         1,0 = reserved "
+    6: (not used)
+    7: solve path, 1 = this cell part of solve path
+  }
+
+
+var
+  flist     : farr;         { list of frontier cells in random order }
+  cell      : ^cellarr;      { pointers and flags, on heap }
+  fnum,
+  width,
+  height,
+  blockwidth,
+  halfblock,
+  maxrun    : word;
+  runset    : byte;
+  ch        : char;
+
+procedure initbgi;
+var
+  grdriver,
+  grmode,
+  errcode : integer;
+begin
+  grdriver := vga;
+  grmode   := vgahi;
+  initgraph(grdriver, grmode, 'd:\pp\bp\bgi');
+  errcode:= graphresult;
+  if errcode <> grok then
+  begin
+    CloseGraph;
+    writeln('Graphics error: ', grapherrormsg(errcode));
+    halt(1);
+  end;
+end;
+
+
+function adjust(var x, y : word; d : byte) : boolean;
+begin                              { take x,y to next cell in direction d }
+  case d of                        { returns false if new x,y is off grid }
+    rightdir:
+    begin
+      inc (x);
+      adjust:= x <= width;
+    end;
+
+    updir:
+    begin
+      dec (y);
+      adjust:= y > 0;
+    end;
+
+    leftdir:
+    begin
+      dec (x);
+      adjust:= x > 0;
+    end;
+
+    downdir:
+    begin
+      inc (y);
+      adjust:= y <= height;
+    end;
+  end;
+end;
+
+
+procedure remove(x, y : word);      { remove a frontier cell from flist }
+var
+  i : word; { done by moving last entry in flist into it's place }
+begin
+  i := cell^[x,y].point;          { old pointer }
+  with flist[fnum] do
+    cell^[column,row].point := i;   { move pointer }
+  flist[i] := flist[fnum];        { move data }
+  dec(fnum);                    { one less to worry about }
+end;
+
+
+procedure add(x, y : word; d : byte);  { add a frontier cell to flist }
+var
+  i : byte;
+begin
+  i := cell^[x,y].flags;
+  case i and $30 of   { check cell type }
+    unused :
+    begin
+      cell^[x,y].flags := i or frontier;  { change to frontier cell }
+      inc(fnum);                        { have one more to worry about }
+      if fnum > flistsize then
+      begin     { flist overflow error! }
+        dispose(cell);  { clean up memory }
+        closegraph;
+        writeln('flist overflow! - To correct, increase "flistsize"');
+        write('hit return to halt program ');
+        readln;
+        halt(1);        { exit program }
+      end;
+      with flist[fnum] do
+      begin    { copy data into last entry of flist }
+        column := x;
+        row    := y;
+      end;
+      cell^[x,y].point := fnum; { make the pointer point to the new cell }
+      runset := runset or d;   { indicate that a cell in direction d was }
+    end;                      {    added to the flist }
+
+    frontier : runset := runset or d;     { allready in flist }
+  end;
+end;
+
+
+procedure addfront(x, y : word);    { change all unused cells around this }
+var                              {    base cell to frontier cells }
+  j, k : word;
+  d    : byte;
+begin
+  remove(x, y);       { first remove base cell from flist, it is now }
+  runset := 0;         {    part of the tree }
+  cell^[x,y].flags := cell^[x,y].flags or tree;   { change to tree cell }
+  d := $01;            { look in all four directions- $01,$02,$04,$08 }
+  while d <= $08 do
+  begin
+    j := x;
+    k := y;
+    if adjust(j, k, d) then
+      add(j, k, d);  { add only if still in bounds }
+    d := d shl 1;    { try next direction }
+  end;
+end;
+
+
+procedure remline(x, y : word; d : byte);  { erase line connecting two blocks }
+begin
+  setcolor(background);
+  x := (x - 1) * blockwidth;
+  y := (y - 1) * blockwidth;
+  case d of
+    rightdir : line (x + blockwidth, y + 1, x + blockwidth, y + blockwidth - 1);
+    updir    : line (x + 1, y, x + blockwidth - 1, y);
+    leftdir  : line (x, y + 1, x, y + blockwidth - 1);
+    downdir  : line (x + 1, y + blockwidth, x + blockwidth - 1, y + blockwidth);
+  end;
+end;
+
+
+{ erase line and update flags to indicate the barrier has been removed }
+procedure rembar(x, y : word; d : byte);
+var
+  d2 : byte;
+begin
+  remline(x, y, d);       { erase line }
+  cell^[x,y].flags := cell^[x,y].flags or d; { show barrier removed dir. d }
+  d2 := d shl 2;  { shift left twice to reverse direction }
+  if d2 > $08 then
+    d2 := d2 shr 4;  { wrap around }
+  if adjust(x, y, d) then  { do again from adjacent cell back to base cell }
+    cell^[x,y].flags := cell^[x,y].flags or d2;    { skip if out of bounds }
+end;
+
+
+function randomdir : byte;  { get a random direction }
+begin
+  case random(4) of
+    0 : randomdir := rightdir;
+    1 : randomdir := updir;
+    2 : randomdir := leftdir;
+    3 : randomdir := downdir;
+  end;
+end;
+
+
+procedure connect(x, y : word);    { connect this new branch to the tree }
+var                             {    in a random direction }
+  j, k  : word;
+  d     : byte;
+  found : boolean;
+begin
+  found := false;
+  while not found do
+  begin { loop until we find a tree cell to connect to }
+    j := x;
+    k := y;
+    d := randomdir;
+    if adjust(j, k, d) then
+      found := cell^[j,k].flags and $30 = tree;
+  end;
+  rembar(x, y, d);   { remove barrier connecting the cells }
+end;
+
+
+procedure branch(x, y : word);  { make a new branch of the tree }
+var
+  runnum : word;
+  d      : byte;
+begin
+  runnum := maxrun;      { max number of tree cells to add to a branch }
+  connect(x, y);        { first connect frontier cell to the tree }
+  addfront(x, y);       { convert neighboring unused cells to frontier }
+  dec(runnum);         { number of tree cells left to add to this branch }
+  while (runnum > 0) and (fnum > 0) and (runset > 0) do
+  begin
+    repeat
+      d := randomdir;
+    until d and runset > 0;  { pick random direction to known frontier }
+    rembar(x, y, d);          {    and make it part of the tree }
+    adjust(x, y, d);
+    addfront(x, y);      { then pick up the neighboring frontier cells }
+    dec(runnum);
+  end;
+end;
+
+
+procedure drawmaze;
+var
+  x, y, i : word;
+begin
+  setcolor(gridcolor);    { draw the grid }
+  y := height * blockwidth;
+  for i := 0 to width do
+  begin
+    x := i * blockwidth;
+    line(x, 0, x, y);
+  end;
+  x := width * blockwidth;
+  for i := 0 to height do
+  begin
+    y := i * blockwidth;
+    line (0, y, x, y);
+  end;
+  fillchar(cell^, sizeof(cell^), chr(0));    { zero flags }
+  fnum   := 0;   { number of frontier cells in flist }
+  runset := 0; { directions to known frontier cells from a base cell }
+  randomize;
+  x := random(width) + 1;   { pick random start cell }
+  y := random(height) + 1;
+  add(x, y, rightdir);       { direction ignored }
+  addfront(x, y);      { start with 1 tree cell and some frontier cells }
+  while (fnum > 0) do
+  with flist[random(fnum) + 1] do
+    branch(column, row);
+end;
+
+procedure dot(x, y, colr : word);
+begin
+  putpixel(blockwidth * x - halfblock, blockwidth * y - halfblock, colr);
+end;
+
+procedure solve(x, y, endx, endy : word);
+var
+  j, k : word;
+  d    : byte;
+begin
+  d := rightdir;  { starting from left side of maze going right }
+  while (x <> endx) or (y <> endy) do
+  begin
+    if d = $01 then
+      d := $08
+    else
+      d := d shr 1; { look right, hug right wall }
+    while cell^[x,y].flags and d = 0 do
+    begin { look for an opening }
+      d := d shl 1;                            { if no opening, turn left }
+      if d > $08 then
+        d := d shr 4;
+    end;
+    j := x;
+    k := y;
+    adjust(x, y, d);         { go in that direction }
+    with cell^[j,k] do
+    begin    { turn on dot, off if we were here before }
+      flags := ((((cell^[x,y].flags xor $80) xor flags) and $80) xor flags);
+      if flags and $80 <> 0 then
+        dot(j, k, solvecolor)
+      else
+        dot(j, k, background);
+    end;
+  end;
+  dot(endx, endy, solvecolor);    { dot last cell on }
+end;
+
+procedure mansolve (x,y,endx,endy: word);
+var
+  j, k : word;
+  d    : byte;
+  ch   : char;
+begin
+  ch := ' ';
+  while ((x <> endx) or (y <> endy)) and (ch <> 'X') and (ch <> #27) do
+  begin
+    dot(x, y, solvecolor);    { dot man on, show where we are in maze }
+    ch := upcase(readkey);
+    dot(x, y, background);    { dot man off after keypress }
+    d := 0;
+    case ch of
+      #0:
+      begin
+        ch := readkey;
+        case ch of
+          #72 : d := updir;
+          #75 : d := leftdir;
+          #77 : d := rightdir;
+          #80 : d := downdir;
+        end;
+      end;
+
+      'I' : d := updir;
+      'J' : d := leftdir;
+      'K' : d := rightdir;
+      'M' : d := downdir;
+    end;
+
+    if d > 0 then
+    begin
+      j := x;
+      k := y;    { move if no wall and still in bounds }
+      if (cell^[x,y].flags and d > 0) and adjust(j, k, d) then
+      begin
+        x := j;
+        y := k;
+      end;
+    end;
+  end;
+end;
+
+procedure solvemaze;
+var
+  x, y,
+  endx,
+  endy : word;
+begin
+  x := 1;                         { pick random start on left side wall }
+  y := random(height) + 1;
+  endx := width;                  { pick random end on right side wall }
+  endy := random(height) + 1;
+  remline(x, y, leftdir);         { show start and end by erasing line }
+  remline(endx, endy, rightdir);
+  mansolve(x, y, endx, endy);      { try it manually }
+  solve(x, y, endx, endy);         { show how when he gives up }
+  while keypressed do
+   readkey;
+  readkey;
+end;
+
+
+procedure getsize;
+var
+  j, k : real;
+begin
+  clrscr;
+  writeln('       Mind');
+  writeln('       Over');
+  writeln('       Maze');
+  writeln;
+  writeln('   by Randy Ding');
+  writeln;
+  writeln('Use I,J,K,M or arrow keys to walk thru maze,');
+  writeln('then hit X when you give up!');
+  repeat
+    writeln;
+    write('Maze size: ', minblockwidth, ' (hard) .. 95 (easy) ');
+    readln(blockwidth);
+  until (blockwidth >= minblockwidth) and (blockwidth < 96);
+  writeln;
+  write('Maximum branch length: 1 easy .. 50 harder, (0 unlimited) ');
+  readln(maxrun);
+  if maxrun <= 0 then
+    maxrun := 65535;  { infinite }
+  j := Real(screenwidth) / blockwidth;
+  k := Real(screenheight) / blockwidth;
+  if j = int(j) then
+    j := j - 1;
+  if k = int(k) then
+    k := k - 1;
+  width  := trunc(j);
+  height := trunc(k);
+  if (width > maxx) or (height > maxy) then
+  begin
+    width  := maxx;
+    height := maxy;
+  end;
+  halfblock := blockwidth div 2;
+end;
+
+begin
+  repeat
+    getsize;
+    initbgi;
+    new(cell);    { allocate this large array on heap }
+    drawmaze;
+    solvemaze;
+    dispose(cell);
+    closegraph;
+    while keypressed do
+      ch := readkey;
+    write ('another one? ');
+    ch := upcase (readkey);
+  until (ch = 'N') or (ch = #27);
+end.
+

install/demo/graph/quad.pp

@@ -0,0 +1,682 @@
+PROGRAM Quad;
+{A demo which loads some graphics etc. Nice. Don't forget to distribute
+quaddata.inc!
+
+The sources for this game was found on a site that claims to only have
+PD stuff with the below header(which was only reindented), and the webmaster
+said that everything he published was sent to him with that purpose. We tried
+to contact the authors mentioned below via mail over internet, but that
+failed. If there is somebody that claims authorship of these programs,
+please mail [email protected], and the sources will be removed from our
+websites.
+
+------------------------------------------------------------------------
+
+ORIGINAL Header:
+
+Programmed by: Justin Pierce
+Graphics by: Whitney Pierce
+Inspired by: Jos Dickman''s triple memory!
+-----
+
+Old version requires egavga.bgi. FPC doesn't require BGI's (VGA and VESA
+support are built in the Graph, others are ignored).}
+
+Uses Crt,Dos,Graph,
+      GameUnit;         {Supplied with FPC demoes package. Wrapper for
+                          mousesupport (via msmouse or api), and contains
+                          highscore routines}
+
+Const nox             = 10;
+      noy             = 8;
+      card_border     = red;
+      PicBufferSize   = 64000;  {Buffersize for deRLE'ed picture data}
+      ComprBufferSize = 20000;  {Buffer for diskread- RLE'ed data}
+      PicsFilename    = 'quaddata.dat';  {Name of picturesfile}
+      ScoreFileName   = 'quad.scr';
+
+Type
+    pByte           = ^Byte;                  {BufferTypes}
+    Card            = Record
+                       exposed: boolean;
+                       pic: byte;
+                      End;
+
+            {Assigns an enumeration to each picture}
+    PictureEnum= (zero,one,two,three,four,five,six,seven,eight,nine,colon,
+                  back,score,exit_b,score_b,chunk,p1,p2,p3,p4,p5,p6,p7,p8,
+                  p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20);
+
+            {A pictures definition;
+              x and y dimensions and offset in PicData buffer}
+
+    Picture = packed Record
+                start: longint;
+                x,y: byte;
+                End;
+
+    {All pictures. This array, and the data in PicData is all pic info.}
+    PictureArray= ARRAY[zero..p20] OF Picture;
+
+    selected = Record
+                 x,y: byte;
+                 pic: byte;
+                End;
+    time_record = Record
+                    o_hr,o_min,o_sec,o_sec100: word;
+                    hr,min,sec,sec100: word;
+                    a_sec,a_min: word;
+    End;
+
+Var b           : array[1..nox,1..noy] Of card;
+    Pics        : PictureArray;
+    PicData     : PByte;
+    s           : array[1..4] Of selected;
+    os          : byte;
+    turns       : integer;
+    off,ok,exit1: boolean;
+    opened      : byte;
+    bgidirec    : string;
+    time        : time_record;
+
+{
+Procedure fatal(fcall:String);
+Begin
+  textmode(CO80);
+  clrscr;
+  Writeln('A fatal error has occured');
+  Writeln('Error: ',fcall);
+  Writeln;
+  Write('Hit enter to halt program--');
+  readln;
+  halt;
+End;
+}
+
+Procedure ginit640x480x16(direc:String);
+
+Var grd,grmode: integer;
+Begin
+  closegraph;
+  grd := 9;{ detect;}
+  grmode := 2;{ m800x600x16;}
+  initgraph(grd,grmode,direc);
+  setgraphmode(2);
+End;
+
+Procedure clean_board;
+
+Var x,y: byte;
+Begin
+  y := 1;
+  Repeat
+    x := 1;
+    Repeat
+      b[x,y].pic := 0;
+      b[x,y].exposed := false;
+      inc(x);
+    Until x>nox;
+    inc(y);
+  Until y>noy
+End;
+
+Procedure showpic(xp,yp:integer; tp:pictureenum);
+
+Var x,y,x1,y1: byte;
+    tx: integer;
+Begin
+  x := pics[tp].x; {mb[tp.start];}
+  y := pics[tp].y; {mb[tp.start+1];}
+  y1 := 1;
+  tx := 0;
+  Repeat
+    x1 := 1;
+    Repeat
+      putpixel(xp+(x1-1),yp+(y1-1),picdata[pics[tp].start-1+tx]);
+      inc(x1);
+      inc(tx);
+    Until x1>x;
+    inc(y1);
+  Until y1>y;
+End;
+
+Procedure NumberOutput(X,Y,Number:LONGINT;RightY:BOOLEAN);
+
+Var num: string;
+    plc: byte;
+
+Begin
+  str(number,num);
+  If length(num)=1 Then
+   insert('0',num,0);
+  IF RightY THEN
+   dec (x,length(num)*11);
+  plc := 1;
+  Repeat
+   IF (Num[plc]>CHR(47)) AND (Num[plc]<CHR(58)) THEN
+    showpic(((plc-1)*11)+X,Y,pictureenum(ORD(Zero)+ORD(Num[plc])-48));
+   inc(plc);
+  Until plc>length(num);
+End;
+
+Procedure update_secs;
+
+Begin
+ showpic(605,453,colon);
+ NumberOutput(615,453,time.a_sec,FALSE);
+End;
+
+Procedure showturn(x,y:integer);
+
+Begin
+  hidemouse;
+  If (x=0) And (y=0) Then
+   NumberOutput(4,453,Turns,FALSE)
+  ELSE
+   NumberOutput(x,y,Turns,FALSE);
+  showmouse;
+End;
+
+Procedure get_original_time;
+Begin
+  With time Do
+    Begin
+      a_sec := 0;
+      a_min := 0;
+      gettime(o_hr,o_min,o_sec,o_sec100);
+      gettime(hr,min,sec,sec100);
+    End;
+End;
+
+Procedure update_time(ForcedUpdate:BOOLEAN);
+Begin
+  With time Do
+    Begin
+      gettime(hr,min,sec,sec100);
+
+      If sec<>o_sec Then
+        Begin
+          inc(a_sec);
+          If a_sec<=60 Then update_secs;
+        End;
+      If a_sec>60 Then
+        Begin
+          a_sec := 0;
+          inc(a_min);
+          ForcedUpdate:=TRUE;
+        End;
+      IF ForcedUpdate THEN
+       BEGIN
+        Update_secs;
+        showpic(606,453,colon);
+        NumberOutput(606,453,time.a_min,TRUE);
+       END;
+      o_hr := hr;
+      o_min := min;
+      o_sec := sec;
+      o_sec100 := sec;
+    End;
+End;
+
+
+Procedure makecard(x,y:byte);
+
+Var xp,yp: integer;
+Begin
+  hidemouse;
+  xp := ((x-1)*63);
+  yp := ((y-1)*56);
+  setcolor(card_border);
+  setfillstyle(1,0);
+  bar(xp+1,yp+1,xp+62,yp+55);
+  rectangle(xp,yp,xp+63,yp+56);
+  If b[x,y].exposed=false Then
+    Begin
+      showpic(xp+1,yp+1,back);
+    End;
+  showmouse;
+  If b[x,y].exposed=true Then
+    Begin
+      hidemouse;
+      showpic(xp+7,yp+4,pictureenum(ORD(b[x,y].pic)+ORD(p1)-1));
+      showmouse;
+    End;
+End;
+
+Function used(pic:byte): byte;
+
+Var cx,cy,u: byte;
+Begin
+  used := 0;
+  u := 0;
+  cy := 1;
+  Repeat
+    cx := 1;
+    Repeat
+      If b[cx,cy].pic=pic Then inc(u);
+      inc(cx);
+    Until cx>nox;
+    inc(cy);
+  Until cy>noy;
+  used := u;
+End;
+
+Procedure set_board;
+
+CONST Outstr=#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+
+             #219+#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+#219+
+             #219+#219+#219+#219;
+
+Var cx,cy,pic: byte;
+Begin
+  setcolor(0);
+  outtextxy(0,470,OutStr);
+  setcolor(green);
+  outtextxy(0,470,'Dealing board, please wait...');
+  Delay(1000);
+  cy := 1;
+  Repeat
+    cx := 1;
+    Repeat
+      Repeat
+        pic := random(20)+1;
+      Until used(pic)<4;
+      b[cx,cy].pic := pic;
+      makecard(cx,cy);
+      inc(cx);
+    Until cx>nox;
+    inc(cy);
+  Until cy>noy;
+  setcolor(0);
+  outtextxy(0,470,OutStr);
+End;
+
+Procedure fire_works;
+
+Const
+  nof = 30;
+
+Type
+  fires = Record
+            x,y: Longint;
+            direct: longint;
+            speed: Longint;
+            explode: boolean;
+            color: byte;
+            oex: longint;
+End;
+
+Var fire: array[1..nof] Of fires;
+
+Procedure clean_fires;
+
+Var c: longint;
+Begin
+  c := 1;
+  Repeat
+    fire[c].direct := random(2)+1;
+    fire[c].color := random(15)+1;
+    fire[c].x := random(639);
+    fire[c].y := 479;
+    fire[c].explode := false;
+    fire[c].speed := random(20)+15;
+    fire[c].oex := 1;
+    inc(c);
+  Until c>nof;
+End;
+
+Procedure inact;
+
+Var c: longint;
+Begin
+  c := 1;
+  Repeat
+    If fire[c].explode=false Then
+      Begin
+        setcolor(fire[c].color);
+        circle(fire[c].x,fire[c].y,1);
+      End;
+
+    If (fire[c].explode=true) And (fire[c].oex<10) Then
+      Begin
+        setcolor(fire[c].color);
+        circle(fire[c].x,fire[c].y,fire[c].oex);
+        setcolor(random(15)+1);
+        circle(fire[c].x,fire[c].y,fire[c].oex-1);
+      End;
+
+    inc(c);
+  Until c>nof;
+
+  delay(75);
+  gotoxy(1,1);
+
+  c := 1;
+  Repeat
+    setcolor(0);
+    circle(fire[c].x,fire[c].y,1);
+
+    If (fire[c].explode=true) And (fire[c].oex<10) Then
+      Begin
+        circle(fire[c].x,fire[c].y,fire[c].oex);
+        circle(fire[c].x,fire[c].y,fire[c].oex-1);
+        inc(fire[c].oex);
+      End;
+
+    If fire[c].explode=false Then
+      Begin
+        dec(fire[c].speed,1);
+        dec(fire[c].y,fire[c].speed);
+        If fire[c].direct=1 Then inc(fire[c].x,2);
+        If fire[c].direct=2 Then dec(fire[c].x,2);
+        If fire[c].speed<=(-1*LONGINT(random(11))) Then
+         fire[c].explode := true;
+      End;
+
+    inc(c);
+  Until c>nof;
+  c := 1;
+End;
+
+Function exploded: boolean;
+
+Var c: longint;
+    m: boolean;
+Begin
+  c := 1;
+  m := true;
+  Repeat
+    If fire[c].oex<6 Then m := false;
+    inc(c);
+  Until (c>nof);
+  exploded := m;
+End;
+
+Begin
+  cleardevice;
+  Repeat
+    clean_fires;
+    Repeat
+      inact;
+    Until (exploded=true) Or (keypressed);
+  Until keypressed;
+End;
+
+Procedure win;
+
+Var m,s: string;
+    I,J   : LONGINT;
+
+Begin
+  hidemouse;
+  fire_works;
+  cleardevice;
+  closegraph;
+  textmode(co80+font8x8);
+  clrscr;
+  I:=SlipInScore(Turns);
+  GotoXY(1,23);
+  Writeln('Game Over, turns needed = ',Turns);
+  FOR J:=9 TO 22 DO
+   BEGIN
+    GotoXY(20,J);
+    Write(' ':38);
+   END;
+ IF I<>0 THEN
+  BEGIN
+   ShowHighScore;
+{$IFDEF USEGRAPHICS}
+   GrInputStr(S,20,21-I,16,12,10,FALSE,AlfaBeta);
+{$ELSE}
+   InputStr(S,20,21-I,10,FALSE,AlfaBeta);
+{$ENDIF}
+   IF Length(S)<12 THEN
+    BEGIN
+     str(time.a_min,m);
+     S:=S+'['+m+':';
+     str(time.a_sec,m);
+     S:=S+'m'+']';
+    END;
+   HighScore[I-1].Name:=S;
+  END;
+  ShowHighScore;
+  ginit640x480x16(bgidirec);
+  off := false;
+  clean_board;
+  set_board;
+  turns := 0;
+  showpic(0,450,score);
+  showpic(80,450,score_b);
+  showpic(150,450,exit_b);
+  showpic(569,450,score);
+  showturn(0,0);
+  exit1 := false;
+  get_original_time;
+  update_time(True);
+  SetMousePosition(0,0);
+  showmouse;
+End;
+
+Procedure show_scores;
+
+Var x,y,c: byte;
+Begin
+  hidemouse;
+
+  y := 1;
+  Repeat
+    x := 1;
+    showpic(x+135,(y-1)*21,score);
+    showpic(x,(y-1)*21,score);
+    showpic(x+204,(y-1)*21,score);
+    Repeat
+      showpic(((x-1)*10)+3,(y-1)*21,chunk);
+      inc(x);
+    Until x>20;
+    inc(y);
+  Until y>10;
+
+  c := 0;
+  Repeat
+    If HighScore[c].name<>'' Then
+      Begin
+        setcolor(white);
+        outtextxy(4,7+(c*21),HighScore[c].name);
+        turns := HighScore[c].Score;
+        showturn(211,3+(c*21));
+      End;
+    inc(c);
+  Until c>9;
+  turns := 0;
+  gotoxy(1,1);
+  readln;
+
+  off := false;
+  clean_board;
+  set_board;
+  turns := 0;
+  showpic(0,450,score);
+  showpic(80,450,score_b);
+  showpic(150,450,exit_b);
+  showpic(569,450,score);
+  showturn(0,0);
+  exit1 := false;
+  get_original_time;
+  update_time(True);
+  SetMousePosition(0,0);
+  showmouse;
+End;
+
+Procedure interpret;
+
+Var mpx,mpy: byte;
+    ms_mx,ms_my,ms_but : LONGINT;
+Begin
+  GetMouseState(ms_mx,ms_my,ms_but);
+  ms_mx:=ms_mx shr 1;;
+
+  If ms_but=0 Then off := false;
+
+  If ((ms_but AND 1)=1) And (off=false) Then
+    Begin
+      off := true;
+      mpx := ms_mx*2 Div 63;
+      mpy := (ms_my) Div 56;
+
+      If (ms_mx*2>=80) And (ms_mx*2<=129) And (ms_my>=450) And (ms_my<=466)
+         And (ok=true) Then show_scores;
+      If (ms_mx*2>=150) And (ms_mx*2<=199) And (ms_my>=450) And (ms_my<=466)
+        Then
+        Begin
+          exit1 := true;
+        End;
+
+      inc(mpx);
+      inc(mpy);
+      If (b[mpx,mpy].exposed=false) And (mpx>=1) And (mpy>=1) And (mpx<=10) And (mpy<=8)
+        Then
+        Begin
+          setfillstyle(1,0);
+          bar(80,450,130,466);
+          ok := false;
+          b[mpx,mpy].exposed := true;
+          makecard(mpx,mpy);
+          inc(os);
+          s[os].x := mpx;
+          s[os].y := mpy;
+          s[os].pic := b[mpx,mpy].pic;
+        End;
+    End;
+
+  If os=4 Then
+    Begin
+      inc(turns);
+      showturn(0,0);
+      os := 0;
+      delay(700);
+      inc(opened);
+      If Not((s[1].pic=s[2].pic) And (s[1].pic=s[3].pic) And (s[1].pic=s[4].pic)) Then
+        Begin
+          dec(opened);
+          b[s[1].x,s[1].y].exposed := false;
+          b[s[2].x,s[2].y].exposed := false;
+          b[s[3].x,s[3].y].exposed := false;
+          b[s[4].x,s[4].y].exposed := false;
+          makecard(s[1].x,s[1].y);
+          makecard(s[2].x,s[2].y);
+          makecard(s[3].x,s[3].y);
+          makecard(s[4].x,s[4].y);
+        End;
+      If opened=20 Then win;
+    End;
+
+  If NOT ok Then
+   update_time(FALSE);
+End;
+
+Procedure load_pics(PicBuf:PByte);
+{loads picture structures from disc}
+
+VAR  F           : File;
+     Buf1Ind,
+     I,J,K       : LONGINT;
+     TData       : PByte;
+
+Begin
+  GetMem(TData,ComprBufferSize);        { allocate buffer}
+  Assign(F,Picsfilename);             { Open file}
+  {$I-}
+  Reset(F,1);
+  {$I+}
+  If ioresult<>0 Then
+   BEGIN
+    TextMode(CO80);
+    Writeln('Fatal error, couldn''t find graphics data file quaddata.dat');
+    HALT;
+   END;
+
+  {Read the array with picture information; (X,Y dimensions and offset in
+          binary data)}
+  BlockRead(F,pics,SIZEOF(Picture)*(ORD(p20)-ORD(zero)+1),I);
+
+  {Read some slackspace which shouldn't be in the file ;-)}
+  blockread(F,TData[0],6,Buf1ind);
+
+  {Read the real, RLE'ed graphics data}
+  BlockRead(F,TData[0],ComprBufferSize,Buf1Ind);
+  Close(F);
+
+  {Expand the RLE data. Of each byte, the high nibble is the count-1, low
+    nibble is the value}
+
+  I:=0; J:=0;
+  REPEAT
+   K:=(TData[I] SHR 4) +1;
+   FillChar(PicBuf[J],K,TData [I] AND 15);
+   INC(J,K);
+   INC(I);
+  UNTIL I>=Buf1Ind;
+
+  {Release the temporary buffer (the compressed data isn't necesary anymore)}
+  Freemem(TData,ComprBufferSize);
+End;
+
+Procedure clean;
+
+VAR I : LONGINT;
+
+Begin
+  Randomize;                                    {Initialize random generator}
+  Negative:=TRUE;                               {Higher highscore is worse}
+  HighX:=20;   HighY:=9;                        {coordinates for highscores}
+
+  GetMem(PicData,PicBufferSize);                {Allocate room for pictures}
+  load_pics(PicData);                           {Load picture data from file}
+  FOR I:=0 TO 9 DO                              {Create default scores}
+   HighScore[I].Score:=-100*I;                  {Negative, because then the
+                                                  "highest" score is best}
+  LoadHighScore(ScoreFileName);                 {Try to load highscore file}
+  closegraph;
+  bgidirec := 'd:\prog\bp\bgi';
+  ginit640x480x16(bgidirec);
+  setcolor(card_border);
+  ok := true;
+  opened := 0;
+  os := 0;
+  s[1].x := 0;
+  s[2].x := 0;
+  s[3].x := 0;
+  off := false;
+  clean_board;
+  set_board;
+  turns := 0;
+  showpic(0,450,score);        showpic(80,450,score_b);
+  showpic(150,450,exit_b);     showpic(569,450,score);
+  showturn(0,0);
+  exit1 := false;
+  SetMousePosition(0,0);
+  get_original_time;
+  update_time(True);
+  showmouse;
+End;
+
+Begin
+
+  clean;
+  Repeat
+    interpret;
+  Until exit1=true;
+  closegraph;
+  textmode(co80);
+  Freemem(PicData,PicBufferSize);
+  clrscr;
+  SaveHighScore;
+  Writeln('Thanks for playing Quadruple Memory');
+  Writeln('Feel free to distribute this software.');
+  Writeln;
+  Writeln('Programmed by: Justin Pierce');
+  Writeln('Graphics by: Whitney Pierce');
+  Writeln('Inspired by: Jos Dickman''s triple memory!');
+  Writeln('FPC conversion and cleanup by Marco van de Voort');
+  Writeln;
+End.

install/demo/graph/samegame.pp

@@ -0,0 +1,576 @@
+{
+    $Id$
+
+    This program is both available in XTDFPC as in the FPC demoes.
+    Copyright (C) 1999 by Marco van de Voort
+
+    SameGame is a standard game in GNOME and KDE. I liked it, and I
+    automatically brainstormed how I would implement it.
+    It turned out to be really easy, and is basically only 100 lines or so,
+    the rest is scorekeeping, helptext, menu etc.
+
+    The game demonstrates some features of the MSMOUSE unit, and some of
+    the Crt and Graph units. (depending whether it is compiled with
+    UseGraphics or not)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+PROGRAM SameGame;
+
+Uses Crt,Dos,
+{$IFDEF UseGraphics}
+ Graph,
+{$ENDIF}
+ GameUnit;
+
+CONST
+   {$IFDEF UseGraphics}
+        GrFieldX                          = 10; {X topleft of playfield}
+        GrFieldY                          = 70; {Y topleft of playfield}
+        ScalerX                           = 22; {ScalerX x Scaler y dots
+                                                  must be approx a square}
+        ScalerY                           = 20;
+   {$ENDIF}
+        FieldX                            = 10; {Top left playfield
+                                                 coordinates in squares(textmode)}
+        FieldY                            =  3; {Top left playfield coordinates}
+        PlayFieldXDimension               = 20; {Dimensions of playfield}
+        PlayFieldYDimension               = 15;
+   {$IFDEF UseGraphics}
+        RowDispl                          = 15;
+        MenuX                             = 480;
+        MenuY                             = 120;
+        grNewGameLine                     = 'NEW GAME';
+        grHelpLine                        = 'HELP';
+        grEndGame                         = 'END GAME';
+   {$ENDIF}
+
+
+       {Used colors. Colors[0..2] are the colors used on the playfield, Colors[3]
+          is the background and Colors[4] is the color used to mark the pieces}
+        Colors : ARRAY [0..4] OF LONGINT  = (White,Blue,Red,Black,LightMagenta);
+
+
+TYPE PlayFieldType=ARRAY[0..PlayFieldXDimension-1,0..PlayFieldYDimension-1] OF BYTE;
+
+{$IFDEF UseGraphics}
+PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
+{Screen routine, simply puts the array Playfield on screen.
+Both used for displaying the normal grid as the grid with a certain area marked}
+
+VAR X,Y : LONGINT;
+    LastOne,
+    NumbLast : LONGINT;
+
+BEGIN
+ HideMouse;
+ FOR Y:=0 TO PlayFieldYDimension-1 DO
+  BEGIN
+   X:=0;
+   REPEAT
+    LastOne:=PlayField[X,Y];
+    NumbLast:=X;
+    WHILE (PlayField[X,Y]=LastOne) AND (X<(PlayFieldXDimension-1))DO
+     INC(X);
+    SetFillStyle(SolidFill,Colors[LastOne]);
+    Bar(GrFieldX+NumbLast*ScalerX,GrFieldY+Y*ScalerY,GrFieldX+X*ScalerX-1,GrFieldY+(Y+1)*ScalerY-1);
+   UNTIL X>=(PlayFieldXDimension-1);
+  END;
+ ShowMouse;
+END;
+{$ELSE}
+
+PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
+{Screen routine, simply puts the array Playfield on screen.
+Both used for displaying the normal grid as the grid with a certain area marked}
+
+VAR X,Y : LONGINT;
+
+BEGIN
+ FOR Y:=0 TO PlayFieldYDimension-1 DO
+  BEGIN
+   GotoXY(FieldX,Y+FieldY);
+   FOR X:=0 TO PlayFieldXDimension-1 DO
+    BEGIN
+     TextColor(Colors[PlayField[X,Y]]);
+     Write(#219#219);
+    END;
+   END;
+END;
+{$ENDIF}
+
+PROCEDURE ShowHelp;
+{Shows some explanation of the game and waits for a key}
+
+{$ifndef UseGraphics}
+VAR I : LONGINT;
+{$endif}
+
+BEGIN
+ {$IFDEF UseGraphics}
+  HideMouse;
+  SetbkColor(black);
+  SetViewPort(0,0,getmaxx,getmaxy,clipoff);
+  ClearViewPort;
+  SetTextStyle(0,Horizdir,2);
+  OutTextXY(220,10,'SAMEGAME');
+  SetTextStyle(0,Horizdir,1);
+  OutTextXY(5,40+1*LineDistY,' is a small game, with a principle copied from some KDE game');
+  OutTextXY(5,40+3*LineDistY,'I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
+  OutTextXY(5,40+4*LineDistY,'When it worked, I tried to get it running under Linux. I succeeded,');
+  OutTextXY(5,40+5*LineDistY,'but the mouse unit of the API doesn'#39't work with GPM 1.17');
+  OutTextXY(5,40+7*LineDistY,'If you move over the playfield, aggregates of one color will be marked');
+  OutTextXY(5,40+8*LineDistY,'in purple. If you then press the left mouse button, that aggregate will');
+  OutTextXY(5,40+9*LineDistY,'disappear, and the playfield will collapse to the bottom-left. Please');
+  OutTextXY(5,40+10*LineDistY,'keep in mind that only an aggregate of two blocks or more will disappear.');
+  OutTextXY(5,40+12*LineDistY,'For every aggregate you let disappear you get points, but the score is');
+  OutTextXY(5,40+13*LineDistY,'quadratic proportional to the number of blocks killed. So 4 times killing');
+  OutTextXY(5,40+14*LineDistY,' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
+  OutTextXY(5,40+15*LineDistY,'blocks. The purpose of the game is obtaining the highscore');
+  OutTextXY(5,40+17*LineDistY,'If you manage to empty the entire playfield, you'#39'll get a bonus');
+  OutTextXY(5,40+19*LineDistY,'Press any key to get back to the game');
+  ShowMouse;
+ {$ELSE}
+  FOR I:=2 TO 24 DO
+   BEGIN
+    GotoXY(1,I);
+    ClrEol;
+   END;
+  GotoXY(1,3); TextColor(White);
+  Write('SAMEGAME');
+  SetDefaultColor;
+  WriteLn(' is a small game, with a principle copied from some KDE game');
+  WriteLn;
+  WriteLn('I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
+  Writeln('When it worked, I tried to get it running under Linux. I succeeded,');
+  Writeln('but the mouse unit of the API doesn'#39't work with GPM 1.17');
+  Writeln;
+  WriteLn('If you move over the playfield, aggregates of one color will be marked');
+  Writeln('in purple. If you then press the left mouse button, that aggregate will');
+  Writeln('disappear, and the playfield will collapse to the bottom-left. Please');
+  Writeln('keep in mind that only an aggregate of two blocks or more will disappear.');
+  Writeln;
+  Writeln('For every aggregate you let disappear you get points, but the score is');
+  Writeln('quadratic proportional to the number of blocks killed. So 4 times killing');
+  Writeln(' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
+  Writeln('blocks. The purpose of the game is obtaining the highscore');
+  Writeln;
+  Writeln('If you manage to empty the entire playfield, you'#39'll get a bonus');
+  Writeln;
+  WriteLn('Press any key to get back to the game');
+ {$ENDIF}
+  GetKey;
+END;
+
+VAR MarkField,PlayField : PlayFieldType; {The playfield, and the marked form}
+    CubesMarked         : LONGINT;       {Cubes currently marked}
+    Score               : LONGINT;       {The current score}
+    LastScore           : LONGINT;
+
+PROCEDURE ShowButtons;
+{Shows the clickable buttons}
+
+BEGIN
+ {$IFNDEF UseGraphics}
+ TextColor(Yellow); TextBackGround(Blue);
+ GotoXY(60,5);   Write('NEW game');
+ GotoXY(60,6);   Write('HELP');
+ GotoXY(60,7);   Write('END game');
+ {$IFDEF Linux}
+  GotoXY(60,8);   Write('Force IBM charset');
+ {$ENDIF}
+  SetDefaultColor;
+ {$ELSE}
+ SetTextStyle(0,Horizdir,1);
+ OutTextXY(MenuX,MenuY,grNewGameLine);
+ OutTextXY(MenuX,MenuY+RowDispl,grHelpLine);
+ OutTextXY(MenuX,MenuY+2*RowDispl,grEndGame);
+  {$ENDIF}
+
+END;
+
+FUNCTION PlayFieldPiecesLeft:LONGINT;
+{Counts pieces/cubes/blocks left on the playfield}
+
+VAR I,J,K : LONGINT;
+
+BEGIN
+ K:=0;
+ FOR I:=0 TO PlayFieldXDimension-1 DO
+  FOR J:=0 TO PlayFieldYDimension-1 DO
+   IF PlayField[I,J]<>3 THEN
+    INC(K);
+ PlayFieldPiecesLeft:=K;
+END;
+
+PROCEDURE ShowScore;
+{Simply procedure to update the score}
+
+{$IFDEF UseGraphics}
+VAR S : String;
+{$ENDIF}
+BEGIN
+ {$IFDEF UseGraphics}
+  Str(Score:5,S);
+  SetFillStyle(SolidFill,0);
+  Bar(300,440,450,458);
+  OutTextXY(300,440,'Score :'+S);
+ {$ELSE}
+ TextColor(White);
+ GotoXY(20,23);   Write(' ':20);
+ GotoXY(20,23);   Write('Score : ',Score);
+ SetDefaultColor;
+ {$ENDIF}
+END;
+
+FUNCTION CubesToScore : LONGINT;
+{Function to calculate score from the number of cubes. Should have a higher
+order than linear, or the purpose of the game disappears}
+
+BEGIN
+ CubesToScore:=(CubesMarked*CubesMarked) DIV 4;
+END;
+
+PROCEDURE MarkAfield(X,Y:LONGINT);
+{Recursively marks the area adjacent to (X,Y);}
+
+VAR TargetColor : LONGINT;
+
+PROCEDURE MarkRecur(X1,Y1:LONGINT);
+{Marks X1,Y1, checks if neighbours (horizontally or vertically) are the
+same color}
+
+BEGIN
+ IF (PlayField[X1,Y1]=TargetColor) AND (MarkField[X1,Y1]<>4) THEN
+  BEGIN
+   MarkField[X1,Y1]:=4;
+   INC(CubesMarked);
+  IF X1>0 THEN
+   MarkRecur(X1-1,Y1);
+  IF Y1>0 THEN
+   MarkRecur(X1,Y1-1);
+  IF X1<(PlayFieldXDimension-1) THEN
+   MarkRecur(X1+1,Y1);
+  IF Y1<(PlayFieldYDimension-1) THEN
+   MarkRecur(X1,Y1+1);
+  END;
+END;
+
+BEGIN
+ CubesMarked:=0;
+ TargetColor:=PlayField[X,Y];
+ IF TargetColor<>3 THEN         {Can't mark black space}
+  MarkRecur(X,Y);
+END;
+
+PROCEDURE FillPlayfield;
+{Initial version, probably not nice to play with.
+Some Life'ish algoritm would be better I think. (so that more aggregates exist)}
+
+VAR X,Y,Last,Now : LONGINT;
+
+BEGIN
+ Last:=0;
+ FOR X:=0 TO PlayFieldXDimension-1 DO
+  FOR Y:=0 TO PlayFieldYDimension-1 DO
+   BEGIN
+    Now:=RANDOM(4);
+    IF Now=3 THEN
+     Now:=Last;
+    PlayField[X,Y]:=Now;
+    Last:=Now;
+   END;
+  MarkField:=PlayField;
+END;
+
+PROCEDURE Colapse;
+{Processes the playfield if the mouse button is used.
+
+  First the procedure deletes the marked area, and let gravity do its work
+  Second the procedure uses as if some gravity existed on the left of the
+  playfield }
+
+VAR X, Y,J :LONGINT;
+
+BEGIN
+ {Vertical colapse: All marked pieces are deleted, and let gravity do it's work}
+ IF CubesMarked>1 THEN
+  BEGIN
+   FOR X:=0 TO PlayFieldXDimension-1 DO
+    BEGIN
+     Y:=PlayFieldYDimension-1; J:=Y;
+     REPEAT
+       IF MarkField[X,Y]<>4 THEN
+        BEGIN
+         PlayField[X,J]:=PlayField[X,Y];
+         DEC(J);
+        END;
+       DEC(Y);
+      UNTIL Y<0;
+    FOR Y:=0 TO J  DO
+     PlayField[X,Y]:=3;
+    END;
+   J:=0;
+   FOR X:=PlayFieldXDimension-2 DOWNTO 0  DO
+    BEGIN
+     IF PlayfIeld[X,PlayFieldYDimension-1]=3 THEN
+      BEGIN
+       Move(PlayfIeld[X+1,0],PlayField[X,0],PlayFieldYDimension*(PlayFieldXDimension-X-1));
+       INC(J);
+      END;
+    END;
+   IF J<>0 THEN
+    FillChar(PlayField[PlayFieldXDimension-J,0],J*PlayFieldYDimension,#3);
+   INC(Score,CubesToScore);
+   ShowScore;
+  END;
+END;
+
+PROCEDURE BuildScreen;
+{Some procedures that build the screen}
+
+BEGIN
+  {$IFDEF UseGraphics}
+   setbkcolor(black);
+   setviewport(0,0,getmaxx,getmaxy,clipoff);
+   clearviewport;
+  {$ELSE}
+   ClrScr;
+  {$ENDIF}
+  Score:=0;
+  ShowScore;
+  ShowButtons;
+  ShowHighScore;
+  ShowMouse;
+  {$IFDEF UseGraphics}
+
+   SetTextStyle(0,Horizdir,2);
+   OuttextXY(10,10,'SameGame v0.03, (C) by Marco v/d Voort. ');
+   SetTextStyle(0,Horizdir,1);
+   OuttextXY(50,40,'A demo for the FPC RTL and API units Crt,(MS)Mouse and Graph');
+  {$ELSE}
+  GotoXY(1,1);
+  TextColor(Yellow);
+  Write('SameGame v0.02');
+  TextColor(White);
+  Write('   A demo for the ');
+  TextColor(Yellow); Write('FPC');
+  TextColor(White); Write(' API or MsMouse unit. By Marco van de Voort');
+  SetDefaultColor;
+  {$ENDIF}
+  IF LastScore<>0 THEN
+   BEGIN
+    GotoXY(10,20);
+    Write('The score in the last game was :',LastScore);
+   END;
+  DisplayPlayField(PlayField);
+ MarkField:=PlayField;
+END;
+
+PROCEDURE DoMainLoopMouse;
+{The main game loop. The entire game runs in this procedure, the rest is
+    initialisation/finalisation (like loading and saving highscores etc etc)}
+
+VAR X,Y,
+    MX,MY,MState,Dummy : LONGINT;
+    EndOfGame          : LONGINT;
+    S                  : String;
+
+BEGIN
+ RANDOMIZE;
+ REPEAT
+  FillPlayField;
+  BuildScreen;
+  EndOfGame:=0;
+  REPEAT
+   GetMouseState(MX,MY,MState);
+   {$IFDEF UseGraphics}
+    X:=2*((MX-GrFieldX) DIV ScalerX) +FieldX;
+    Y:=((MY-GrFieldY) DIV ScalerY) +FieldY-1;
+   {$ELSE}
+    X:=MX SHR 3;
+    Y:=MY SHR 3;
+   {$ENDIF}
+   IF PlayFieldPiecesLeft=0 THEN
+    BEGIN
+     INC(Score,1000);
+     EndOfGame:=1;
+    END
+   ELSE
+    BEGIN
+     {$IFDEF UseGraphics}
+      IF (MX>=MenuX) AND (MX<(MenuX+16*Length(GrNewGameLine))) THEN
+       BEGIN {X in clickable area}
+        IF (MY>=MenuY) AND (MY<(MenuY+RowDispl*3+2)) THEN
+         BEGIN
+          X:=65; {X doesn't matter as long as it is 60..69}
+          Y:=((MY-MenuY) DIV RowDispl)+4;
+         END;
+       END;
+     {$ENDIF}
+     IF (X>=60) AND (X<=69) THEN
+      BEGIN
+         IF (MState AND LButton) <>0 THEN {If leftbutton pressed,}
+          BEGIN
+           IF Y=4 THEN
+            EndOfGame:=1;
+           IF Y=6 THEN
+            EndOfGame:=2;
+           IF (EndOfGame>0) AND (PlayFieldPiecesLeft=0) THEN
+            INC(Score,1000);
+           IF Y=5 THEN
+            BEGIN
+             ShowHelp;
+             BuildScreen;
+            END;
+           {$IFDEF Linux}
+           IF Y=7 THEN
+            BEGIN
+             write(#27+'(K');
+             BuildScreen;
+            END;
+           {$ENDIF}
+        END;
+      END;
+    IF (X>=(FieldX-2)) AND (Y>=(FieldY-2)) THEN
+     BEGIN
+
+      DEC(X,FieldX-1);
+      DEC(Y,FieldY-1);
+      X:=X SHR 1;
+      IF (X<PlayFieldXDimension) AND (Y<PlayFieldYDimension) THEN
+       BEGIN
+        IF MarkField[X,Y]<>4 THEN
+         BEGIN
+          MarkField:=PlayField;
+          MarkAfield(X,Y);
+          DisplayPlayField(MarkField);
+          TextColor(White);
+          GotoXY(20,22);
+          Write(' ':20);
+          GotoXY(20,22);
+          Write('Marked :',CubesToScore);
+         END;
+        IF (MarkField[X,Y]=4) AND ((MState AND LButton) <>0) THEN
+                                   {If leftbutton pressed,}
+         BEGIN
+          REPEAT                            {wait untill it's released.
+                                           The moment of pressing counts}
+           GetMouseState(X,Y,Dummy);
+          UNTIL (Dummy AND LButton)=0;
+          Colapse;
+          MarkField:=PlayField;
+          DisplayPlayField(MarkField);
+        END
+      END
+    END;
+   IF KeyPressed THEN
+    BEGIN
+     X:=GetKey;
+     IF (CHR(X) IN ['X','x','Q','q']) OR (X=27) THEN
+      EndOfGame:=2;
+    END;
+   END;
+  UNTIL EndOfGame>0;
+  ShowScore;
+  X:=SlipInScore(Score);
+  IF X<>0 THEN
+   BEGIN
+    HideMouse;
+    ShowHighScore;
+    {$IFDEF UseGraphics}
+     Str(Score:5,S);
+     OutTextXY(HighX+150,HighY+LineDistY*(10-X),S);
+     GrInputStr(S,HighX,HighY+LineDistY*(10-X),16,12,10,FALSE,AlfaBeta);
+    {$ELSE}
+     InputStr(S,HighX,HighY+12-X,10,FALSE,AlfaBeta);
+    {$ENDIF}
+    HighScore[X-1].Name:=S;
+    ShowMouse;
+   END;
+  LastScore:=Score;
+  UNTIL EndOFGame=2;
+END;
+
+CONST FileName='samegame.scr';
+
+VAR I : LONGINT;
+    {$IFDEF UseGraphics}
+    gd,gm : INTEGER;
+    Pal   : PaletteType;
+    {$ENDIF}
+
+BEGIN
+ {$IFDEF UseGraphics}
+  gm:=vgahi;
+  gd:=vga;
+  InitGraph(gd,gm,'');
+  if GraphResult <> grOk then
+    begin
+      Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
+      Halt(1);
+    end;
+  SetFillStyle(SolidFill,1);
+  GetDefaultPalette(Pal);
+  SetAllPalette(Pal);
+ {$ENDIF}
+  IF NOT MousePresent THEN
+   BEGIN
+    Writeln('No mouse found. A mouse is required!');
+    HALT;
+   END;
+  FOR I:=1 TO 10 DO
+   HighScore[I].Score:=I*1500;
+  LoadHighScore(FileName);
+  InitMouse;
+  CursorOff;
+ {$IFDEF UseGraphics}
+    HighX:=450;   HighY:=220; {the position of the highscore table}
+ {$else}
+    HighX:=52;   HighY:=10; {the position of the highscore table}
+  {$endif}
+
+  DoMainLoopMouse;
+
+  HideMouse;
+  DoneMouse;
+  CursorOn;
+  SaveHighScore;
+  {$IFDEF UseGraphics}
+   CloseGraph;
+  {$ENDIF}
+  ClrScr;
+  Writeln;
+  Writeln('Last games'#39' score was : ',Score);
+END.
+{
+  $Log$
+  Revision 1.1  2000-03-09 02:40:04  alex
+  moved files
+
+  Revision 1.5  2000/03/08 21:01:48  alex
+  braced some vars to avoid compiler warnings
+
+  Revision 1.4  2000/01/21 00:44:51  peter
+    * remove unused vars
+    * renamed to .pp
+
+  Revision 1.3  1999/12/31 17:04:22  marco
+
+
+  Graphical version
+
+  Revision 1.2  1999/06/01 19:24:33  peter
+    * updates from marco
+
+  Revision 1.1  1999/05/27 21:36:34  peter
+    * new demo's
+    * fixed mandel for linux
+
+}