diff options
| author | marco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2008-01-27 14:42:46 +0000 |
|---|---|---|
| committer | marco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2008-01-27 14:42:46 +0000 |
| commit | 5d105de969bd0f768deff0509125381a9a91851f (patch) | |
| tree | 363cc5975e95ccf2ea10fdfaf9a836cdd9b29343 /packages/ptc | |
| parent | a5d6cc0caf5faefddd1d00044970d30117294738 (diff) | |
| download | fpc-5d105de969bd0f768deff0509125381a9a91851f.tar.gz | |
* moved ptc
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@10050 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/ptc')
196 files changed, 40994 insertions, 0 deletions
diff --git a/packages/ptc/Makefile b/packages/ptc/Makefile new file mode 100644 index 0000000000..ac7cb30e96 --- /dev/null +++ b/packages/ptc/Makefile @@ -0,0 +1,3224 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/01/26] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 watcom +FORCE: +.PHONY: FORCE +override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) +ifneq ($(findstring darwin,$(OSTYPE)),) +inUnix=1 #darwin +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +ifeq ($(findstring ;,$(PATH)),) +inUnix=1 +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +SEARCHPATH:=$(subst ;, ,$(PATH)) +endif +endif +SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) +ifeq ($(PWD),) +$(error You need the GNU utils package to use this Makefile) +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT= +endif +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT=.exe +endif +ifndef inUnix +ifeq ($(OS),Windows_NT) +inWinNT=1 +else +ifdef OS2_SHELL +inOS2=1 +endif +endif +else +ifneq ($(findstring cygdrive,$(PATH)),) +inCygWin=1 +endif +endif +ifdef inUnix +SRCBATCHEXT=.sh +else +ifdef inOS2 +SRCBATCHEXT=.cmd +else +SRCBATCHEXT=.bat +endif +endif +ifdef COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +RUNBATCH=$(COMSPEC) /C +endif +endif +ifdef inUnix +PATHSEP=/ +else +PATHSEP:=$(subst /,\,/) +ifdef inCygWin +PATHSEP=/ +endif +endif +ifdef PWD +BASEDIR:=$(subst \,/,$(shell $(PWD))) +ifdef inCygWin +ifneq ($(findstring /cygdrive/,$(BASEDIR)),) +BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) +BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) +BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) +endif +endif +else +BASEDIR=. +endif +ifdef inOS2 +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO=echo +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +endif +override DEFAULT_FPCDIR=../.. +ifndef FPC +ifdef PP +FPC=$(PP) +endif +endif +ifndef FPC +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +endif +override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) +override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) +FOUNDFPC:=$(strip $(wildcard $(FPC))) +ifeq ($(FOUNDFPC),) +FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) +ifeq ($(FOUNDFPC),) +$(error Compiler $(FPC) not found) +endif +endif +ifndef FPC_COMPILERINFO +FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) +endif +ifndef FPC_VERSION +FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) +endif +export FPC FPC_VERSION FPC_COMPILERINFO +unexport CHECKDEPEND ALLDEPENDENCIES +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif +ifneq ($(words $(FPC_COMPILERINFO)),5) +FPC_COMPILERINFO+=$(shell $(FPC) -iSP) +FPC_COMPILERINFO+=$(shell $(FPC) -iTP) +FPC_COMPILERINFO+=$(shell $(FPC) -iSO) +FPC_COMPILERINFO+=$(shell $(FPC) -iTO) +endif +ifndef CPU_SOURCE +CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) +endif +FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +TARGETSUFFIX=$(FULL_TARGET) +SOURCESUFFIX=$(FULL_SOURCE) +endif +ifneq ($(FULL_TARGET),$(FULL_SOURCE)) +CROSSCOMPILE=1 +endif +ifeq ($(findstring makefile,$(MAKECMDGOALS)),) +ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) +$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) +endif +endif +ifneq ($(findstring $(OS_TARGET),$(BSDs)),) +BSDhier=1 +endif +ifeq ($(OS_TARGET),linux) +linuxHier=1 +endif +export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE +ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +else +override FPCDIR=wrong +endif +ifdef DEFAULT_FPCDIR +ifeq ($(FPCDIR),wrong) +override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +endif +endif +ifeq ($(FPCDIR),wrong) +ifdef inUnix +override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) +ifeq ($(wildcard $(FPCDIR)/units),) +override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) +endif +else +override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(BASEDIR) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=c:/pp +endif +endif +endif +endif +endif +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +override PACKAGE_NAME=ptc +override PACKAGE_VERSION=0.99.5 +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_UNITS+=ptc +endif +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_LOADERS+=$(CPU_LOADERS) +endif +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_EXAMPLEDIRS+=demos examples +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_INCLUDEDIR+=src +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_UNITDIR+=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa src/win32/directx src +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_TARGETDIR+=. +endif +ifdef REQUIRE_UNITSDIR +override UNITSDIR+=$(REQUIRE_UNITSDIR) +endif +ifdef REQUIRE_PACKAGESDIR +override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) +endif +ifdef ZIPINSTALL +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 +endif +else +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 +endif +endif +ifndef INSTALL_PREFIX +ifdef PREFIX +INSTALL_PREFIX=$(PREFIX) +endif +endif +ifndef INSTALL_PREFIX +ifdef UNIXHier +INSTALL_PREFIX=/usr/local +else +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=/pp +else +INSTALL_BASEDIR:=/$(PACKAGE_NAME) +endif +endif +endif +export INSTALL_PREFIX +ifdef INSTALL_FPCSUBDIR +export INSTALL_FPCSUBDIR +endif +ifndef DIST_DESTDIR +DIST_DESTDIR:=$(BASEDIR) +endif +export DIST_DESTDIR +ifndef COMPILER_UNITTARGETDIR +ifdef PACKAGEDIR_MAIN +COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) +else +COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) +endif +endif +ifndef COMPILER_TARGETDIR +COMPILER_TARGETDIR=. +endif +ifndef INSTALL_BASEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) +endif +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX) +endif +endif +ifndef INSTALL_BINDIR +ifdef UNIXHier +INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin +else +INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin +ifdef INSTALL_FPCPACKAGE +ifdef CROSSCOMPILE +ifdef CROSSINSTALL +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +endif +endif +endif +ifndef INSTALL_UNITDIR +INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) +ifdef INSTALL_FPCPACKAGE +ifdef PACKAGE_NAME +INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) +endif +endif +endif +ifndef INSTALL_LIBDIR +ifdef UNIXHier +INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib +else +INSTALL_LIBDIR:=$(INSTALL_UNITDIR) +endif +endif +ifndef INSTALL_SOURCEDIR +ifdef UNIXHier +ifdef BSDhier +SRCPREFIXDIR=share/src +else +ifdef linuxHier +SRCPREFIXDIR=share/src +else +SRCPREFIXDIR=src +endif +endif +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source +endif +endif +endif +ifndef INSTALL_DOCDIR +ifdef UNIXHier +ifdef BSDhier +DOCPREFIXDIR=share/doc +else +ifdef linuxHier +DOCPREFIXDIR=share/doc +else +DOCPREFIXDIR=doc +endif +endif +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc +endif +endif +endif +ifndef INSTALL_EXAMPLEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) +endif +endif +else +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +endif +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples +endif +endif +endif +ifndef INSTALL_DATADIR +INSTALL_DATADIR=$(INSTALL_BASEDIR) +endif +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +endif +ifdef CROSSCOMPILE +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) +ifeq ($(CROSSBINDIR),) +CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) +endif +endif +else +CROSSBINDIR= +endif +ifeq ($(OS_SOURCE),linux) +ifndef GCCLIBDIR +ifeq ($(CPU_TARGET),i386) +ifneq ($(findstring x86_64,$(shell uname -a)),) +ifeq ($(BINUTILSPREFIX),) +GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) +endif +endif +endif +ifeq ($(CPU_TARGET),powerpc64) +ifeq ($(BINUTILSPREFIX),) +GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) +endif +endif +endif +ifndef GCCLIBDIR +CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(CROSSGCC),) +GCCLIBDIR:=$(shell dirname `$(CROSSGCC) -print-libgcc-file-name`) +endif +endif +ifndef OTHERLIBDIR +OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }') +endif +endif +ifdef inUnix +ifeq ($(OS_SOURCE),netbsd) +OTHERLIBDIR+=/usr/pkg/lib +endif +export GCCLIBDIR OTHERLIB +endif +BATCHEXT=.bat +LOADEREXT=.as +EXEEXT=.exe +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),morphos) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=mos +endif +ifeq ($(OS_TARGET),atari) +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +ifeq ($(OS_TARGET),darwin) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +else +ifeq ($(OS_TARGET),go32v1) +PPUEXT=.pp1 +OEXT=.o1 +ASMEXT=.s1 +SMARTEXT=.sl1 +STATICLIBEXT=.a1 +SHAREDLIBEXT=.so1 +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +PPUEXT=.ppw +OEXT=.ow +ASMEXT=.sw +SMARTEXT=.slw +STATICLIBEXT=.aw +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +PPUEXT=.ppo +ASMEXT=.so2 +OEXT=.oo2 +AOUTEXT=.out +SMARTEXT=.sl2 +STATICLIBPREFIX= +STATICLIBEXT=.ao2 +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),atari) +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +FPCMADE=fpcmade.$(SHORTSUFFIX) +ZIPSUFFIX=$(SHORTSUFFIX) +ZIPCROSSPREFIX= +ZIPSOURCESUFFIX=src +ZIPEXAMPLESUFFIX=exm +else +FPCMADE=fpcmade.$(TARGETSUFFIX) +ZIPSOURCESUFFIX=.source +ZIPEXAMPLESUFFIX=.examples +ifdef CROSSCOMPILE +ZIPSUFFIX=.$(SOURCESUFFIX) +ZIPCROSSPREFIX=$(TARGETSUFFIX)- +else +ZIPSUFFIX=.$(TARGETSUFFIX) +ZIPCROSSPREFIX= +endif +endif +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO= __missing_command_ECHO +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +ifndef DATE +DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE= __missing_command_DATE +else +DATE:=$(firstword $(DATE)) +endif +else +DATE:=$(firstword $(DATE)) +endif +endif +export DATE +ifndef GINSTALL +GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL= __missing_command_GINSTALL +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +endif +export GINSTALL +ifndef CPPROG +CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(CPPROG),) +CPPROG= __missing_command_CPPROG +else +CPPROG:=$(firstword $(CPPROG)) +endif +endif +export CPPROG +ifndef RMPROG +RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(RMPROG),) +RMPROG= __missing_command_RMPROG +else +RMPROG:=$(firstword $(RMPROG)) +endif +endif +export RMPROG +ifndef MVPROG +MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MVPROG),) +MVPROG= __missing_command_MVPROG +else +MVPROG:=$(firstword $(MVPROG)) +endif +endif +export MVPROG +ifndef MKDIRPROG +MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG= __missing_command_MKDIRPROG +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +endif +export MKDIRPROG +ifndef ECHOREDIR +ifndef inUnix +ECHOREDIR=echo +else +ECHOREDIR=$(ECHO) +endif +endif +ifndef COPY +COPY:=$(CPPROG) -fp +endif +ifndef COPYTREE +COPYTREE:=$(CPPROG) -Rfp +endif +ifndef MKDIRTREE +MKDIRTREE:=$(MKDIRPROG) -p +endif +ifndef MOVE +MOVE:=$(MVPROG) -f +endif +ifndef DEL +DEL:=$(RMPROG) -f +endif +ifndef DELTREE +DELTREE:=$(RMPROG) -rf +endif +ifndef INSTALL +ifdef inUnix +INSTALL:=$(GINSTALL) -c -m 644 +else +INSTALL:=$(COPY) +endif +endif +ifndef INSTALLEXE +ifdef inUnix +INSTALLEXE:=$(GINSTALL) -c -m 755 +else +INSTALLEXE:=$(COPY) +endif +endif +ifndef MKDIR +MKDIR:=$(GINSTALL) -m 755 -d +endif +export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR +ifndef PPUMOVE +PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(PPUMOVE),) +PPUMOVE= __missing_command_PPUMOVE +else +PPUMOVE:=$(firstword $(PPUMOVE)) +endif +endif +export PPUMOVE +ifndef FPCMAKE +FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(FPCMAKE),) +FPCMAKE= __missing_command_FPCMAKE +else +FPCMAKE:=$(firstword $(FPCMAKE)) +endif +endif +export FPCMAKE +ifndef ZIPPROG +ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ZIPPROG),) +ZIPPROG= __missing_command_ZIPPROG +else +ZIPPROG:=$(firstword $(ZIPPROG)) +endif +endif +export ZIPPROG +ifndef TARPROG +TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +ifneq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),win32) +ifeq ($(CROSSBINDIR),) +ASNAME=asw +LDNAME=ldw +ARNAME=arw +endif +endif +endif +ifndef ASPROG +ifdef CROSSBINDIR +ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) +else +ASPROG=$(ASNAME) +endif +endif +ifndef LDPROG +ifdef CROSSBINDIR +LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) +else +LDPROG=$(LDNAME) +endif +endif +ifndef RCPROG +ifdef CROSSBINDIR +RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) +else +RCPROG=$(RCNAME) +endif +endif +ifndef ARPROG +ifdef CROSSBINDIR +ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) +else +ARPROG=$(ARNAME) +endif +endif +AS=$(ASPROG) +LD=$(LDPROG) +RC=$(RCPROG) +AR=$(ARPROG) +PPAS=ppas$(SRCBATCHEXT) +ifdef inUnix +LDCONFIG=ldconfig +else +LDCONFIG= +endif +ifdef DATE +DATESTR:=$(shell $(DATE) +%Y%m%d) +else +DATESTR= +endif +ifndef UPXPROG +ifeq ($(OS_TARGET),go32v2) +UPXPROG:=1 +endif +ifeq ($(OS_TARGET),win32) +UPXPROG:=1 +endif +ifdef UPXPROG +UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(UPXPROG),) +UPXPROG= +else +UPXPROG:=$(firstword $(UPXPROG)) +endif +else +UPXPROG= +endif +endif +export UPXPROG +ZIPOPT=-9 +ZIPEXT=.zip +ifeq ($(USETAR),bz2) +TAROPT=vj +TAREXT=.tar.bz2 +else +TAROPT=vz +TAREXT=.tar.gz +endif +override REQUIRE_PACKAGES=rtl hermes +ifeq ($(FULL_TARGET),i386-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),m68k-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),sparc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +endif +ifdef REQUIRE_PACKAGES_RTL +PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_RTL),) +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) +UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) +else +UNITDIR_RTL=$(PACKAGEDIR_RTL) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) +endif +else +PACKAGEDIR_RTL= +UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_RTL),) +UNITDIR_RTL:=$(firstword $(UNITDIR_RTL)) +else +UNITDIR_RTL= +endif +endif +ifdef UNITDIR_RTL +override COMPILER_UNITDIR+=$(UNITDIR_RTL) +endif +endif +ifdef REQUIRE_PACKAGES_HERMES +PACKAGEDIR_HERMES:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hermes/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_HERMES),) +ifneq ($(wildcard $(PACKAGEDIR_HERMES)/units/$(TARGETSUFFIX)),) +UNITDIR_HERMES=$(PACKAGEDIR_HERMES)/units/$(TARGETSUFFIX) +else +UNITDIR_HERMES=$(PACKAGEDIR_HERMES) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_HERMES)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_HERMES) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_HERMES)/$(FPCMADE) +endif +else +PACKAGEDIR_HERMES= +UNITDIR_HERMES:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hermes/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_HERMES),) +UNITDIR_HERMES:=$(firstword $(UNITDIR_HERMES)) +else +UNITDIR_HERMES= +endif +endif +ifdef UNITDIR_HERMES +override COMPILER_UNITDIR+=$(UNITDIR_HERMES) +endif +endif +ifdef REQUIRE_PACKAGES_X11 +PACKAGEDIR_X11:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /x11/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_X11),) +ifneq ($(wildcard $(PACKAGEDIR_X11)/units/$(TARGETSUFFIX)),) +UNITDIR_X11=$(PACKAGEDIR_X11)/units/$(TARGETSUFFIX) +else +UNITDIR_X11=$(PACKAGEDIR_X11) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_X11)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_X11) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_X11)/$(FPCMADE) +endif +else +PACKAGEDIR_X11= +UNITDIR_X11:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /x11/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_X11),) +UNITDIR_X11:=$(firstword $(UNITDIR_X11)) +else +UNITDIR_X11= +endif +endif +ifdef UNITDIR_X11 +override COMPILER_UNITDIR+=$(UNITDIR_X11) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(CPU_TARGET) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(CPU_TARGET) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifdef UNITDIR +override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) +endif +ifdef LIBDIR +override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) +endif +ifdef OBJDIR +override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) +endif +ifdef INCDIR +override FPCOPT+=$(addprefix -Fi,$(INCDIR)) +endif +ifdef LINKSMART +override FPCOPT+=-XX +endif +ifdef CREATESMART +override FPCOPT+=-CX +endif +ifdef DEBUG +override FPCOPT+=-gl +override FPCOPTDEF+=DEBUG +endif +ifdef RELEASE +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +endif +ifdef VERBOSE +override FPCOPT+=-vwni +endif +ifdef COMPILER_OPTIONS +override FPCOPT+=$(COMPILER_OPTIONS) +endif +ifdef COMPILER_UNITDIR +override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) +endif +ifdef COMPILER_LIBRARYDIR +override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) +endif +ifdef COMPILER_OBJECTDIR +override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) +endif +ifdef COMPILER_INCLUDEDIR +override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) +endif +ifdef CROSSBINDIR +override FPCOPT+=-FD$(CROSSBINDIR) +endif +ifdef COMPILER_TARGETDIR +override FPCOPT+=-FE$(COMPILER_TARGETDIR) +ifeq ($(COMPILER_TARGETDIR),.) +override TARGETDIRPREFIX= +else +override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ +endif +endif +ifdef COMPILER_UNITTARGETDIR +override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) +ifeq ($(COMPILER_UNITTARGETDIR),.) +override UNITTARGETDIRPREFIX= +else +override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ +endif +else +ifdef COMPILER_TARGETDIR +override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) +override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) +endif +endif +ifdef CREATESHARED +override FPCOPT+=-Cg +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-Aas +endif +endif +ifeq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),linux) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +endif +ifdef LINKSHARED +endif +ifdef GCCLIBDIR +override FPCOPT+=-Fl$(GCCLIBDIR) +endif +ifdef OTHERLIBDIR +override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR)) +endif +ifdef OPT +override FPCOPT+=$(OPT) +endif +ifdef FPCOPTDEF +override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) +endif +ifdef CFGFILE +override FPCOPT+=@$(CFGFILE) +endif +ifdef USEENV +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif +override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +endif +endif +.PHONY: fpc_loaders +ifneq ($(TARGET_LOADERS),) +override ALLTARGET+=fpc_loaders +override CLEANTARGET+=fpc_loaders_clean +override INSTALLTARGET+=fpc_loaders_install +override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS)) +endif +%$(OEXT): %$(LOADEREXT) +ifdef COMPILER_UNITTARGETDIR + $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $< +else + $(AS) -o $*$(OEXT) $< +endif +fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES) +fpc_loaders_clean: +ifdef COMPILER_UNITTARGETDIR + -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) +else + -$(DEL) $(LOADEROFILES) +endif +fpc_loaders_install: + $(MKDIR) $(INSTALL_UNITDIR) +ifdef COMPILER_UNITTARGETDIR + $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR) +else + $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR) +endif +.PHONY: fpc_units +ifneq ($(TARGET_UNITS)$(TARGET_IMPLICITUNITS),) +override ALLTARGET+=fpc_units +override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) +override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) +override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) +override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) +endif +fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES) +ifdef TARGET_RSTS +override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) +override CLEANRSTFILES+=$(RSTFILES) +endif +.PHONY: fpc_examples +ifneq ($(TARGET_EXAMPLES),) +HASEXAMPLES=1 +override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .lpr,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES))) +override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES)) +override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES))) +override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES) +ifeq ($(OS_TARGET),os2) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES)) +endif +ifeq ($(OS_TARGET),emx) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES)) +endif +endif +ifneq ($(TARGET_EXAMPLEDIRS),) +HASEXAMPLES=1 +endif +fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS)) +.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared +$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) + @$(ECHOREDIR) Compiled > $(FPCMADE) +fpc_all: $(FPCMADE) +fpc_smart: + $(MAKE) all LINKSMART=1 CREATESMART=1 +fpc_debug: + $(MAKE) all DEBUG=1 +fpc_release: + $(MAKE) all RELEASE=1 +.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res +$(COMPILER_UNITTARGETDIR): + $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) +$(COMPILER_TARGETDIR): + $(MKDIRTREE) $(COMPILER_TARGETDIR) +%$(PPUEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(PPUEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.lpr + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.dpr + $(COMPILER) $< + $(EXECPPAS) +%.res: %.rc + windres -i $< -o $@ +vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall +ifdef INSTALL_UNITS +override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) +endif +ifdef INSTALL_BUILDUNIT +override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) +endif +ifdef INSTALLPPUFILES +override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) +ifneq ($(UNITTARGETDIRPREFIX),) +override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) +override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) +endif +override INSTALL_CREATEPACKAGEFPC=1 +endif +ifdef INSTALLEXEFILES +ifneq ($(TARGETDIRPREFIX),) +override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) +endif +endif +fpc_install: all $(INSTALLTARGET) +ifdef INSTALLEXEFILES + $(MKDIR) $(INSTALL_BINDIR) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILES) +endif + $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) +endif +ifdef INSTALL_CREATEPACKAGEFPC +ifdef FPCMAKE +ifdef PACKAGE_VERSION +ifneq ($(wildcard Makefile.fpc),) + $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) Package.fpc $(INSTALL_UNITDIR) +endif +endif +endif +endif +ifdef INSTALLPPUFILES + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) +ifneq ($(INSTALLPPULINKFILES),) + $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) +endif +ifneq ($(wildcard $(LIB_FULLNAME)),) + $(MKDIR) $(INSTALL_LIBDIR) + $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) +ifdef inUnix + ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) +endif +endif +endif +ifdef INSTALL_FILES + $(MKDIR) $(INSTALL_DATADIR) + $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) +endif +fpc_sourceinstall: distclean + $(MKDIR) $(INSTALL_SOURCEDIR) + $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) +fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) +ifdef HASEXAMPLES + $(MKDIR) $(INSTALL_EXAMPLEDIR) +endif +ifdef EXAMPLESOURCEFILES + $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) +endif +ifdef TARGET_EXAMPLEDIRS + $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) +endif +.PHONY: fpc_distinstall +fpc_distinstall: install exampleinstall +.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall +ifndef PACKDIR +ifndef inUnix +PACKDIR=$(BASEDIR)/../fpc-pack +else +PACKDIR=/tmp/fpc-pack +endif +endif +ifndef ZIPNAME +ifdef DIST_ZIPNAME +ZIPNAME=$(DIST_ZIPNAME) +else +ZIPNAME=$(PACKAGE_NAME) +endif +endif +ifndef FULLZIPNAME +FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX) +endif +ifndef ZIPTARGET +ifdef DIST_ZIPTARGET +ZIPTARGET=DIST_ZIPTARGET +else +ZIPTARGET=install +endif +endif +ifndef USEZIP +ifdef inUnix +USETAR=1 +endif +endif +ifndef inUnix +USEZIPWRAPPER=1 +endif +ifdef USEZIPWRAPPER +ZIPPATHSEP=$(PATHSEP) +ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT)) +else +ZIPPATHSEP=/ +endif +ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR)) +ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR)) +ifdef USETAR +ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT) +ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) * +else +ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT) +ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) * +endif +fpc_zipinstall: + $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1 + $(MKDIR) $(DIST_DESTDIR) + $(DEL) $(ZIPDESTFILE) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER) +else + echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER) + echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER) + echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER) +endif +ifdef inUnix + /bin/sh $(ZIPWRAPPER) +else +ifdef RUNBATCH + $(RUNBATCH) (ZIPWRAPPER) +else + $(ZIPWRAPPER) +endif +endif + $(DEL) $(ZIPWRAPPER) +else + $(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE) +endif + $(DELTREE) $(PACKDIR) +fpc_zipsourceinstall: + $(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX) +fpc_zipexampleinstall: +ifdef HASEXAMPLES + $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX) +endif +fpc_zipdistinstall: + $(MAKE) fpc_zipinstall ZIPTARGET=distinstall +.PHONY: fpc_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +endif +ifdef CLEAN_UNITS +override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) +endif +ifdef CLEANPPUFILES +override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) +ifdef DEBUGSYMEXT +override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) +endif +override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) +override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) +endif +fpc_clean: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif +ifdef LIB_NAME + -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) +endif + -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) +fpc_cleanall: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef COMPILER_UNITTARGETDIR +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +endif + -$(DELTREE) units + -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) +ifneq ($(PPUEXT),.ppu) + -$(DEL) *.o *.ppu *.a +endif + -$(DELTREE) *$(SMARTEXT) + -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *_ppas$(BATCHEXT) +ifdef AOUTEXT + -$(DEL) *$(AOUTEXT) +endif +ifdef DEBUGSYMEXT + -$(DEL) *$(DEBUGSYMEXT) +endif +fpc_distclean: cleanall +.PHONY: fpc_baseinfo +override INFORULES+=fpc_baseinfo +fpc_baseinfo: + @$(ECHO) + @$(ECHO) == Package info == + @$(ECHO) Package Name..... $(PACKAGE_NAME) + @$(ECHO) Package Version.. $(PACKAGE_VERSION) + @$(ECHO) + @$(ECHO) == Configuration info == + @$(ECHO) + @$(ECHO) FPC.......... $(FPC) + @$(ECHO) FPC Version.. $(FPC_VERSION) + @$(ECHO) Source CPU... $(CPU_SOURCE) + @$(ECHO) Target CPU... $(CPU_TARGET) + @$(ECHO) Source OS.... $(OS_SOURCE) + @$(ECHO) Target OS.... $(OS_TARGET) + @$(ECHO) Full Source.. $(FULL_SOURCE) + @$(ECHO) Full Target.. $(FULL_TARGET) + @$(ECHO) SourceSuffix. $(SOURCESUFFIX) + @$(ECHO) TargetSuffix. $(TARGETSUFFIX) + @$(ECHO) + @$(ECHO) == Directory info == + @$(ECHO) + @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) + @$(ECHO) + @$(ECHO) Basedir......... $(BASEDIR) + @$(ECHO) FPCDir.......... $(FPCDIR) + @$(ECHO) CrossBinDir..... $(CROSSBINDIR) + @$(ECHO) UnitsDir........ $(UNITSDIR) + @$(ECHO) PackagesDir..... $(PACKAGESDIR) + @$(ECHO) + @$(ECHO) GCC library..... $(GCCLIBDIR) + @$(ECHO) Other library... $(OTHERLIBDIR) + @$(ECHO) + @$(ECHO) == Tools info == + @$(ECHO) + @$(ECHO) As........ $(AS) + @$(ECHO) Ld........ $(LD) + @$(ECHO) Ar........ $(AR) + @$(ECHO) Rc........ $(RC) + @$(ECHO) + @$(ECHO) Mv........ $(MVPROG) + @$(ECHO) Cp........ $(CPPROG) + @$(ECHO) Rm........ $(RMPROG) + @$(ECHO) GInstall.. $(GINSTALL) + @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) + @$(ECHO) Date...... $(DATE) + @$(ECHO) FPCMake... $(FPCMAKE) + @$(ECHO) PPUMove... $(PPUMOVE) + @$(ECHO) Upx....... $(UPXPROG) + @$(ECHO) Zip....... $(ZIPPROG) + @$(ECHO) + @$(ECHO) == Object info == + @$(ECHO) + @$(ECHO) Target Loaders........ $(TARGET_LOADERS) + @$(ECHO) Target Units.......... $(TARGET_UNITS) + @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) + @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) + @$(ECHO) Target Dirs........... $(TARGET_DIRS) + @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) + @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) + @$(ECHO) + @$(ECHO) Clean Units......... $(CLEAN_UNITS) + @$(ECHO) Clean Files......... $(CLEAN_FILES) + @$(ECHO) + @$(ECHO) Install Units....... $(INSTALL_UNITS) + @$(ECHO) Install Files....... $(INSTALL_FILES) + @$(ECHO) + @$(ECHO) == Install info == + @$(ECHO) + @$(ECHO) DateStr.............. $(DATESTR) + @$(ECHO) ZipName.............. $(ZIPNAME) + @$(ECHO) ZipPrefix............ $(ZIPPREFIX) + @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) + @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) + @$(ECHO) FullZipName.......... $(FULLZIPNAME) + @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) + @$(ECHO) + @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) + @$(ECHO) Install binary dir... $(INSTALL_BINDIR) + @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) + @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) + @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) + @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) + @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) + @$(ECHO) Install data dir..... $(INSTALL_DATADIR) + @$(ECHO) + @$(ECHO) Dist destination dir. $(DIST_DESTDIR) + @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) + @$(ECHO) +.PHONY: fpc_info +fpc_info: $(INFORULES) +.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ + fpc_makefile_dirs +fpc_makefile: + $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc +fpc_makefile_sub1: +ifdef TARGET_DIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) +endif +ifdef TARGET_EXAMPLEDIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) +endif +fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) +fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 +fpc_makefiles: fpc_makefile fpc_makefile_dirs +ifeq ($(FULL_TARGET),i386-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-darwin) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),m68k-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),sparc-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +TARGET_EXAMPLEDIRS_DEMOS=1 +TARGET_EXAMPLEDIRS_EXAMPLES=1 +endif +ifdef TARGET_EXAMPLEDIRS_DEMOS +demos_all: + $(MAKE) -C demos all +demos_debug: + $(MAKE) -C demos debug +demos_smart: + $(MAKE) -C demos smart +demos_release: + $(MAKE) -C demos release +demos_units: + $(MAKE) -C demos units +demos_examples: + $(MAKE) -C demos examples +demos_shared: + $(MAKE) -C demos shared +demos_install: + $(MAKE) -C demos install +demos_sourceinstall: + $(MAKE) -C demos sourceinstall +demos_exampleinstall: + $(MAKE) -C demos exampleinstall +demos_distinstall: + $(MAKE) -C demos distinstall +demos_zipinstall: + $(MAKE) -C demos zipinstall +demos_zipsourceinstall: + $(MAKE) -C demos zipsourceinstall +demos_zipexampleinstall: + $(MAKE) -C demos zipexampleinstall +demos_zipdistinstall: + $(MAKE) -C demos zipdistinstall +demos_clean: + $(MAKE) -C demos clean +demos_distclean: + $(MAKE) -C demos distclean +demos_cleanall: + $(MAKE) -C demos cleanall +demos_info: + $(MAKE) -C demos info +demos_makefiles: + $(MAKE) -C demos makefiles +demos: + $(MAKE) -C demos all +.PHONY: demos_all demos_debug demos_smart demos_release demos_units demos_examples demos_shared demos_install demos_sourceinstall demos_exampleinstall demos_distinstall demos_zipinstall demos_zipsourceinstall demos_zipexampleinstall demos_zipdistinstall demos_clean demos_distclean demos_cleanall demos_info demos_makefiles demos +endif +ifdef TARGET_EXAMPLEDIRS_EXAMPLES +examples_all: + $(MAKE) -C examples all +examples_debug: + $(MAKE) -C examples debug +examples_smart: + $(MAKE) -C examples smart +examples_release: + $(MAKE) -C examples release +examples_units: + $(MAKE) -C examples units +examples_examples: + $(MAKE) -C examples examples +examples_shared: + $(MAKE) -C examples shared +examples_install: + $(MAKE) -C examples install +examples_sourceinstall: + $(MAKE) -C examples sourceinstall +examples_exampleinstall: + $(MAKE) -C examples exampleinstall +examples_distinstall: + $(MAKE) -C examples distinstall +examples_zipinstall: + $(MAKE) -C examples zipinstall +examples_zipsourceinstall: + $(MAKE) -C examples zipsourceinstall +examples_zipexampleinstall: + $(MAKE) -C examples zipexampleinstall +examples_zipdistinstall: + $(MAKE) -C examples zipdistinstall +examples_clean: + $(MAKE) -C examples clean +examples_distclean: + $(MAKE) -C examples distclean +examples_cleanall: + $(MAKE) -C examples cleanall +examples_info: + $(MAKE) -C examples info +examples_makefiles: + $(MAKE) -C examples makefiles +examples: + $(MAKE) -C examples all +.PHONY: examples_all examples_debug examples_smart examples_release examples_units examples_examples examples_shared examples_install examples_sourceinstall examples_exampleinstall examples_distinstall examples_zipinstall examples_zipsourceinstall examples_zipexampleinstall examples_zipdistinstall examples_clean examples_distclean examples_cleanall examples_info examples_makefiles examples +endif +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: fpc_examples +shared: fpc_shared +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: fpc_distinstall +zipinstall: fpc_zipinstall +zipsourceinstall: fpc_zipsourceinstall +zipexampleinstall: fpc_zipexampleinstall +zipdistinstall: fpc_zipdistinstall +clean: fpc_clean $(addsuffix _clean,$(TARGET_EXAMPLEDIRS)) +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +.NOTPARALLEL: diff --git a/packages/ptc/Makefile.fpc b/packages/ptc/Makefile.fpc new file mode 100644 index 0000000000..b619d4775b --- /dev/null +++ b/packages/ptc/Makefile.fpc @@ -0,0 +1,30 @@ +# +# Makefile.fpc for PTCPas +# + +[package] +name=ptc +version=0.99.5 + +[target] +units=ptc +loaders=$(CPU_LOADERS) +exampledirs=demos examples + +[compiler] +unitdir=src/x11 src/dos/cga src/dos/fakemode src/dos/textfx2 src/dos/timeunit src/dos/vesa \ + src/win32/directx src +includedir=src +targetdir=. + +[require] +packages=hermes +packages_linux=x11 +packages_freebsd=x11 + +[default] +fpcdir=../.. + + +[rules] +.NOTPARALLEL: diff --git a/packages/ptc/docs/AUTHORS b/packages/ptc/docs/AUTHORS new file mode 100644 index 0000000000..7106e98483 --- /dev/null +++ b/packages/ptc/docs/AUTHORS @@ -0,0 +1,6 @@ +The Free Pascal port was done by: + Nikolay Nikolov (nickysn@users.sourceforge.net) + +It was based on the OpenPTC C++ library by Glenn Fiedler +(http://www.gaffer.org/ptc) and the Hermes C library by Christian Nentwich +(http://hermes.terminal.at) diff --git a/packages/ptc/docs/CHANGES b/packages/ptc/docs/CHANGES new file mode 100644 index 0000000000..0310ed6114 --- /dev/null +++ b/packages/ptc/docs/CHANGES @@ -0,0 +1,22 @@ +0.99.5 + - support for fpc 2.0.0. fpc 1.0.10 support dropped, except for DOS. + - support for amd64 (the code is now 64-bit safe, but still little endian-only) + - fix the (sometimes) missing titlebar when using the metacity window manager + +0.99.4 + - some X11 fixes (missing cdecl's, wrong alignments, etc.) + - FreeBSD and NetBSD now compile and work (dga and XShm still not tested...) + - improved exception handling in demos and examples + +0.99.3 + - support for fpc 1.9.2+ (adapted to use the new unix rtl) + - the dos console uses rdtsc if available for more accurate timing + - some vesa fixes + +0.99.2 + - alt, shift, ctrl modifier keys support for X11 + - key release support for win32 and X11 + - new example (keybrd2) demonstrating the use of key release events + +0.99.1 + - first release to sourceforge diff --git a/packages/ptc/docs/INSTALL b/packages/ptc/docs/INSTALL new file mode 100644 index 0000000000..73dfb6d2b9 --- /dev/null +++ b/packages/ptc/docs/INSTALL @@ -0,0 +1,36 @@ +The supported platforms are Linux (on IA-32 and AMD64), Windows and DOS. +FreeBSD and NetBSD compiles and runs fine on the SourceForge compilefarm, but +I haven't tested it on a local machine, so any feedback (+patches) is welcome. +(At least the basic XImage mode works, XShm and dga are not tested since they +need to run on the same machine as the X server, so I can't test them on the +SourceForge compilefarm.) + +You need Free Pascal Compiler version 2.0.0. Since there's no DOS version of +2.0.0, you need 1.0.10 if you are going to use the DOS version of the library. +Please note that DOS is the only platform where the 1.0.10 compiler is +supported. + + - Compiling the library: +Before starting make sure the FPCDIR environment variable is set correctly. +For example: (windows, fpc version 2.0.0, default install dir) + + set FPCDIR=c:\fpc\2.0.0 + +To compile the library type: + + fpcmake -r + make + +Then you can do: + + make examples + +And then try to run the programs in the demos/ and examples/ dirs. + +If compiling the library fails, make sure you're using the GNU make and not +some other make! (e.g. GNU make is called 'gmake' on FreeBSD and NetBSD) + +'make -v' should report: + GNU Make version x.xx.x, ... etc. :) + +On Windows and DOS this is the 'make' that comes with Free Pascal. diff --git a/packages/ptc/docs/INTRO b/packages/ptc/docs/INTRO new file mode 100644 index 0000000000..653daf2255 --- /dev/null +++ b/packages/ptc/docs/INTRO @@ -0,0 +1,71 @@ +For more complete documentation please refer to the C++ documentation of +OpenPTC. + +This will explain the basics of creating a simple graphics application using +PTC for FPC. :) + +(If you aren't familiar with Delphi classes, please refer to the Free Pascal +Reference guide, Chapter 5 - Classes.) + +There are 3 classes you should get familiar with: TPTCFormat, TPTCSurface and +TPTCConsole. + +Ok, what is TPTCFormat? It basically describes a pixel format. To create a +pixel format for 32 bpp use: + Format := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + +32 is the number of bits per pixel. (Only formats with 8, 16, 24 and 32 bits +per pixel are supported). $FF0000, $FF00 and $FF are the red, green and blue +masks. + + +Now, when you have created your favourite pixel format, you should create a +surface: + Surface := TPTCSurface.Create(320, 200, Format); + +This will create a buffer in RAM to hold a single 320x200 frame in the given +format. Note that TPTCSurface is always created in normal RAM, not video RAM, +so it's not a problem if your video card doesn't have enough memory for it, +or doesn't support e.g. 320x200x32bpp. You just create a TPTCConsole and open +it in whatever mode is supported by the hardware and then PTC will blit the +image stored in TPTCSurface to the console, doing any conversions that are +necessary (i.e. converting to another pixel format, stretching the image to +another resolution, etc...). + + +How to use this TPTCConsole? Easy! First create it: + Console := TPTCConsole.Create; + +This still doesn't do anything, just allocates memory and initializes stuff. +Then you switch to the desired mode: + Console.open('Hello, world!', 320, 200, Format); + +Note that if your hardware doesn't support the requested mode, PTC will try +to switch to the best mode. If (for example) your card doesn't support +320x200 in 32bpp, only in 16bpp, PTC will (probably) switch to that mode. +To see the actual mode that PTC has set use these properties: + Console.width Console.height and Console.format + +Ok, now that you have created a TPTCSurface and opened a TPTCConsole, what to +do next? Draw stuff... The lock function of TPTCSurface will give you a pointer +to the internal buffer. + ptr := Surface.lock; + +Now you can draw your frame in the buffer, pointed by ptr. Note that this buffer +is guaranteed to be in the format and resolution you requested. + +When you're done you have to unlock the surface and copy it to the console: + Surface.unlock; + Surface.copy(Console); + Console.update; + +The Surface.copy(Console) will do the conversion (if necessary) to the actual +mode. Console.update will actually show the new frame (if the console driver +supports multiple pages and you have enough video RAM for that, etc... :) ). + +See the example programs for additional details. (keyboard input, high +resolution timers - they're pretty much straightforward) + +Enjoy! + +Nikolay Nikolov diff --git a/packages/ptc/docs/README b/packages/ptc/docs/README new file mode 100644 index 0000000000..20d9e9b3ca --- /dev/null +++ b/packages/ptc/docs/README @@ -0,0 +1,44 @@ +PTCPas 0.99.5 +Nikolay Nikolov (nickysn@users.sourceforge.net) + +This is a FPC port of the OpenPTC C++ library. It is distributed under the +the terms of the GNU LGPL (see lgpl.txt). + +The latest version can be found at http://ptcpas.sourceforge.net + +Basically it provides an abstraction layer for high-speed low-level graphics +access. It is OOP and supports multiple platforms. (tested on Linux, DOS and +Windows, more will be added in the future) +3d acceleration isn't supported, nor planned. If you need that, you should use +something like OpenGL instead. :-) + +Supported consoles: + DirectX 3+ (should work on all Windows versions since Windows 95, except + Windows CE. This currently means 95/98/ME/NT4/2000/XP/2003. + On NT4 you need SP3 or later. Also some very ancient versions of + Windows 95 do not have any DirectX preinstalled, so it has to be + installed separately.) + X11 (on linux, maybe also other unix-like OSes, supports dga and XShm + extensions) + Vesa 1.2+ (DOS. LFB and video pages not yet supported) + VGA (DOS, fakemodes, mode13h, etc...) + CGA (DOS, added by me just for fun ... and maybe some day I'll even add + EGA :-) ) + Text (DOS, 80x50 - 16 colours, should work even in the most buggy dos boxes + (2000,XP) and IMHO looks better than AALib ;-) ) + +All programs using OpenPTC look (at runtime) for a config file that may contain +various (platform specific) options, so you can try different consoles, etc, +without the need to recompile. It is called ptc.cfg and is searched in the +current directory on DOS and Windows. On unix it is .ptc.conf in the user's +HOME directory. There's an example ptc.cfg file with all supported options, +prefixed with #. If you want to try an option just remove the # and put it in +the same directory as the .exe (or copy to ~/.ptc.conf on unix :) ) + +-------------------------------------------------------------------------------- +The original copyrights from the C++ version: +The X11 classes are Copyright (c) 1998/99 Christian Nentwich (brn@eleet.mcb.at) +The OpenPTC 1.0 C++ API is (c) 1998/99 Glenn Fiedler (ptc@gaffer.org) + +The OpenPTC C++ library can be found at http://www.gaffer.org/ptc +The Hermes C library can be found at http://hermes.terminal.at diff --git a/packages/ptc/docs/TODO b/packages/ptc/docs/TODO new file mode 100644 index 0000000000..d935c9ed0a --- /dev/null +++ b/packages/ptc/docs/TODO @@ -0,0 +1,8 @@ + - key release events support in dos + - mouse support + - multiple video pages and lfb for the vesa console + - test the x11 console (in XShm and dga mode) under *BSD + - big endian support in hermes + - make hermes thread safe (in FPC 1.9.x+) + - delphi (kylix? c++?) bindings + - better timing under dos diff --git a/packages/ptc/docs/lgpl.txt b/packages/ptc/docs/lgpl.txt new file mode 100644 index 0000000000..b1e3f5a263 --- /dev/null +++ b/packages/ptc/docs/lgpl.txt @@ -0,0 +1,504 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the library's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + <signature of Ty Coon>, 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/packages/ptc/examples/Makefile b/packages/ptc/examples/Makefile new file mode 100644 index 0000000000..7fcb744bb4 --- /dev/null +++ b/packages/ptc/examples/Makefile @@ -0,0 +1,2328 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/01/26] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 watcom +FORCE: +.PHONY: FORCE +override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) +ifneq ($(findstring darwin,$(OSTYPE)),) +inUnix=1 #darwin +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +ifeq ($(findstring ;,$(PATH)),) +inUnix=1 +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +SEARCHPATH:=$(subst ;, ,$(PATH)) +endif +endif +SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) +ifeq ($(PWD),) +$(error You need the GNU utils package to use this Makefile) +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT= +endif +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT=.exe +endif +ifndef inUnix +ifeq ($(OS),Windows_NT) +inWinNT=1 +else +ifdef OS2_SHELL +inOS2=1 +endif +endif +else +ifneq ($(findstring cygdrive,$(PATH)),) +inCygWin=1 +endif +endif +ifdef inUnix +SRCBATCHEXT=.sh +else +ifdef inOS2 +SRCBATCHEXT=.cmd +else +SRCBATCHEXT=.bat +endif +endif +ifdef COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +RUNBATCH=$(COMSPEC) /C +endif +endif +ifdef inUnix +PATHSEP=/ +else +PATHSEP:=$(subst /,\,/) +ifdef inCygWin +PATHSEP=/ +endif +endif +ifdef PWD +BASEDIR:=$(subst \,/,$(shell $(PWD))) +ifdef inCygWin +ifneq ($(findstring /cygdrive/,$(BASEDIR)),) +BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) +BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) +BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) +endif +endif +else +BASEDIR=. +endif +ifdef inOS2 +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO=echo +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +endif +override DEFAULT_FPCDIR=../../.. +ifndef FPC +ifdef PP +FPC=$(PP) +endif +endif +ifndef FPC +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +endif +override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) +override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) +FOUNDFPC:=$(strip $(wildcard $(FPC))) +ifeq ($(FOUNDFPC),) +FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) +ifeq ($(FOUNDFPC),) +$(error Compiler $(FPC) not found) +endif +endif +ifndef FPC_COMPILERINFO +FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) +endif +ifndef FPC_VERSION +FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) +endif +export FPC FPC_VERSION FPC_COMPILERINFO +unexport CHECKDEPEND ALLDEPENDENCIES +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif +ifneq ($(words $(FPC_COMPILERINFO)),5) +FPC_COMPILERINFO+=$(shell $(FPC) -iSP) +FPC_COMPILERINFO+=$(shell $(FPC) -iTP) +FPC_COMPILERINFO+=$(shell $(FPC) -iSO) +FPC_COMPILERINFO+=$(shell $(FPC) -iTO) +endif +ifndef CPU_SOURCE +CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) +endif +FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +TARGETSUFFIX=$(FULL_TARGET) +SOURCESUFFIX=$(FULL_SOURCE) +endif +ifneq ($(FULL_TARGET),$(FULL_SOURCE)) +CROSSCOMPILE=1 +endif +ifeq ($(findstring makefile,$(MAKECMDGOALS)),) +ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) +$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) +endif +endif +ifneq ($(findstring $(OS_TARGET),$(BSDs)),) +BSDhier=1 +endif +ifeq ($(OS_TARGET),linux) +linuxHier=1 +endif +export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE +ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +else +override FPCDIR=wrong +endif +ifdef DEFAULT_FPCDIR +ifeq ($(FPCDIR),wrong) +override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +endif +endif +ifeq ($(FPCDIR),wrong) +ifdef inUnix +override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) +ifeq ($(wildcard $(FPCDIR)/units),) +override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) +endif +else +override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(BASEDIR) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=c:/pp +endif +endif +endif +endif +endif +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +override PACKAGE_NAME=ptc-examples +override PACKAGE_VERSION=0.99.5 +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_PROGRAMS+=area buffer clear clip con_info console fire flower hicolor image keyboard keybrd2 land lights modes mojo palette pixel random save stretch texwarp timer tunnel3d tunnel +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_UNITDIR+=../$(UNITTARGETDIRPREFIX) +endif +ifdef REQUIRE_UNITSDIR +override UNITSDIR+=$(REQUIRE_UNITSDIR) +endif +ifdef REQUIRE_PACKAGESDIR +override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) +endif +ifdef ZIPINSTALL +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 +endif +else +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 +endif +endif +ifndef INSTALL_PREFIX +ifdef PREFIX +INSTALL_PREFIX=$(PREFIX) +endif +endif +ifndef INSTALL_PREFIX +ifdef UNIXHier +INSTALL_PREFIX=/usr/local +else +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=/pp +else +INSTALL_BASEDIR:=/$(PACKAGE_NAME) +endif +endif +endif +export INSTALL_PREFIX +ifdef INSTALL_FPCSUBDIR +export INSTALL_FPCSUBDIR +endif +ifndef DIST_DESTDIR +DIST_DESTDIR:=$(BASEDIR) +endif +export DIST_DESTDIR +ifndef COMPILER_UNITTARGETDIR +ifdef PACKAGEDIR_MAIN +COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) +else +COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) +endif +endif +ifndef COMPILER_TARGETDIR +COMPILER_TARGETDIR=. +endif +ifndef INSTALL_BASEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) +endif +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX) +endif +endif +ifndef INSTALL_BINDIR +ifdef UNIXHier +INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin +else +INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin +ifdef INSTALL_FPCPACKAGE +ifdef CROSSCOMPILE +ifdef CROSSINSTALL +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +endif +endif +endif +ifndef INSTALL_UNITDIR +INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) +ifdef INSTALL_FPCPACKAGE +ifdef PACKAGE_NAME +INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) +endif +endif +endif +ifndef INSTALL_LIBDIR +ifdef UNIXHier +INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib +else +INSTALL_LIBDIR:=$(INSTALL_UNITDIR) +endif +endif +ifndef INSTALL_SOURCEDIR +ifdef UNIXHier +ifdef BSDhier +SRCPREFIXDIR=share/src +else +ifdef linuxHier +SRCPREFIXDIR=share/src +else +SRCPREFIXDIR=src +endif +endif +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source +endif +endif +endif +ifndef INSTALL_DOCDIR +ifdef UNIXHier +ifdef BSDhier +DOCPREFIXDIR=share/doc +else +ifdef linuxHier +DOCPREFIXDIR=share/doc +else +DOCPREFIXDIR=doc +endif +endif +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc +endif +endif +endif +ifndef INSTALL_EXAMPLEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) +endif +endif +else +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +endif +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples +endif +endif +endif +ifndef INSTALL_DATADIR +INSTALL_DATADIR=$(INSTALL_BASEDIR) +endif +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +endif +ifdef CROSSCOMPILE +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) +ifeq ($(CROSSBINDIR),) +CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) +endif +endif +else +CROSSBINDIR= +endif +ifeq ($(OS_SOURCE),linux) +ifndef GCCLIBDIR +ifeq ($(CPU_TARGET),i386) +ifneq ($(findstring x86_64,$(shell uname -a)),) +ifeq ($(BINUTILSPREFIX),) +GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) +endif +endif +endif +ifeq ($(CPU_TARGET),powerpc64) +ifeq ($(BINUTILSPREFIX),) +GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) +endif +endif +endif +ifndef GCCLIBDIR +CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(CROSSGCC),) +GCCLIBDIR:=$(shell dirname `$(CROSSGCC) -print-libgcc-file-name`) +endif +endif +ifndef OTHERLIBDIR +OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }') +endif +endif +ifdef inUnix +ifeq ($(OS_SOURCE),netbsd) +OTHERLIBDIR+=/usr/pkg/lib +endif +export GCCLIBDIR OTHERLIB +endif +BATCHEXT=.bat +LOADEREXT=.as +EXEEXT=.exe +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),morphos) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=mos +endif +ifeq ($(OS_TARGET),atari) +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +ifeq ($(OS_TARGET),darwin) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +else +ifeq ($(OS_TARGET),go32v1) +PPUEXT=.pp1 +OEXT=.o1 +ASMEXT=.s1 +SMARTEXT=.sl1 +STATICLIBEXT=.a1 +SHAREDLIBEXT=.so1 +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +PPUEXT=.ppw +OEXT=.ow +ASMEXT=.sw +SMARTEXT=.slw +STATICLIBEXT=.aw +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +PPUEXT=.ppo +ASMEXT=.so2 +OEXT=.oo2 +AOUTEXT=.out +SMARTEXT=.sl2 +STATICLIBPREFIX= +STATICLIBEXT=.ao2 +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),atari) +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +FPCMADE=fpcmade.$(SHORTSUFFIX) +ZIPSUFFIX=$(SHORTSUFFIX) +ZIPCROSSPREFIX= +ZIPSOURCESUFFIX=src +ZIPEXAMPLESUFFIX=exm +else +FPCMADE=fpcmade.$(TARGETSUFFIX) +ZIPSOURCESUFFIX=.source +ZIPEXAMPLESUFFIX=.examples +ifdef CROSSCOMPILE +ZIPSUFFIX=.$(SOURCESUFFIX) +ZIPCROSSPREFIX=$(TARGETSUFFIX)- +else +ZIPSUFFIX=.$(TARGETSUFFIX) +ZIPCROSSPREFIX= +endif +endif +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO= __missing_command_ECHO +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +ifndef DATE +DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE= __missing_command_DATE +else +DATE:=$(firstword $(DATE)) +endif +else +DATE:=$(firstword $(DATE)) +endif +endif +export DATE +ifndef GINSTALL +GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL= __missing_command_GINSTALL +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +endif +export GINSTALL +ifndef CPPROG +CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(CPPROG),) +CPPROG= __missing_command_CPPROG +else +CPPROG:=$(firstword $(CPPROG)) +endif +endif +export CPPROG +ifndef RMPROG +RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(RMPROG),) +RMPROG= __missing_command_RMPROG +else +RMPROG:=$(firstword $(RMPROG)) +endif +endif +export RMPROG +ifndef MVPROG +MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MVPROG),) +MVPROG= __missing_command_MVPROG +else +MVPROG:=$(firstword $(MVPROG)) +endif +endif +export MVPROG +ifndef MKDIRPROG +MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG= __missing_command_MKDIRPROG +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +endif +export MKDIRPROG +ifndef ECHOREDIR +ifndef inUnix +ECHOREDIR=echo +else +ECHOREDIR=$(ECHO) +endif +endif +ifndef COPY +COPY:=$(CPPROG) -fp +endif +ifndef COPYTREE +COPYTREE:=$(CPPROG) -Rfp +endif +ifndef MKDIRTREE +MKDIRTREE:=$(MKDIRPROG) -p +endif +ifndef MOVE +MOVE:=$(MVPROG) -f +endif +ifndef DEL +DEL:=$(RMPROG) -f +endif +ifndef DELTREE +DELTREE:=$(RMPROG) -rf +endif +ifndef INSTALL +ifdef inUnix +INSTALL:=$(GINSTALL) -c -m 644 +else +INSTALL:=$(COPY) +endif +endif +ifndef INSTALLEXE +ifdef inUnix +INSTALLEXE:=$(GINSTALL) -c -m 755 +else +INSTALLEXE:=$(COPY) +endif +endif +ifndef MKDIR +MKDIR:=$(GINSTALL) -m 755 -d +endif +export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR +ifndef PPUMOVE +PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(PPUMOVE),) +PPUMOVE= __missing_command_PPUMOVE +else +PPUMOVE:=$(firstword $(PPUMOVE)) +endif +endif +export PPUMOVE +ifndef FPCMAKE +FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(FPCMAKE),) +FPCMAKE= __missing_command_FPCMAKE +else +FPCMAKE:=$(firstword $(FPCMAKE)) +endif +endif +export FPCMAKE +ifndef ZIPPROG +ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ZIPPROG),) +ZIPPROG= __missing_command_ZIPPROG +else +ZIPPROG:=$(firstword $(ZIPPROG)) +endif +endif +export ZIPPROG +ifndef TARPROG +TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +ifneq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),win32) +ifeq ($(CROSSBINDIR),) +ASNAME=asw +LDNAME=ldw +ARNAME=arw +endif +endif +endif +ifndef ASPROG +ifdef CROSSBINDIR +ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) +else +ASPROG=$(ASNAME) +endif +endif +ifndef LDPROG +ifdef CROSSBINDIR +LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) +else +LDPROG=$(LDNAME) +endif +endif +ifndef RCPROG +ifdef CROSSBINDIR +RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) +else +RCPROG=$(RCNAME) +endif +endif +ifndef ARPROG +ifdef CROSSBINDIR +ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) +else +ARPROG=$(ARNAME) +endif +endif +AS=$(ASPROG) +LD=$(LDPROG) +RC=$(RCPROG) +AR=$(ARPROG) +PPAS=ppas$(SRCBATCHEXT) +ifdef inUnix +LDCONFIG=ldconfig +else +LDCONFIG= +endif +ifdef DATE +DATESTR:=$(shell $(DATE) +%Y%m%d) +else +DATESTR= +endif +ifndef UPXPROG +ifeq ($(OS_TARGET),go32v2) +UPXPROG:=1 +endif +ifeq ($(OS_TARGET),win32) +UPXPROG:=1 +endif +ifdef UPXPROG +UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(UPXPROG),) +UPXPROG= +else +UPXPROG:=$(firstword $(UPXPROG)) +endif +else +UPXPROG= +endif +endif +export UPXPROG +ZIPOPT=-9 +ZIPEXT=.zip +ifeq ($(USETAR),bz2) +TAROPT=vj +TAREXT=.tar.bz2 +else +TAROPT=vz +TAREXT=.tar.gz +endif +override REQUIRE_PACKAGES=rtl hermes ptc +ifeq ($(FULL_TARGET),i386-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),m68k-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),sparc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_X11=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_HERMES=1 +REQUIRE_PACKAGES_PTC=1 +endif +ifdef REQUIRE_PACKAGES_RTL +PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_RTL),) +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) +UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) +else +UNITDIR_RTL=$(PACKAGEDIR_RTL) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) +endif +else +PACKAGEDIR_RTL= +UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_RTL),) +UNITDIR_RTL:=$(firstword $(UNITDIR_RTL)) +else +UNITDIR_RTL= +endif +endif +ifdef UNITDIR_RTL +override COMPILER_UNITDIR+=$(UNITDIR_RTL) +endif +endif +ifdef REQUIRE_PACKAGES_HERMES +PACKAGEDIR_HERMES:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hermes/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_HERMES),) +ifneq ($(wildcard $(PACKAGEDIR_HERMES)/units/$(TARGETSUFFIX)),) +UNITDIR_HERMES=$(PACKAGEDIR_HERMES)/units/$(TARGETSUFFIX) +else +UNITDIR_HERMES=$(PACKAGEDIR_HERMES) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_HERMES)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_HERMES) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_HERMES)/$(FPCMADE) +endif +else +PACKAGEDIR_HERMES= +UNITDIR_HERMES:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hermes/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_HERMES),) +UNITDIR_HERMES:=$(firstword $(UNITDIR_HERMES)) +else +UNITDIR_HERMES= +endif +endif +ifdef UNITDIR_HERMES +override COMPILER_UNITDIR+=$(UNITDIR_HERMES) +endif +endif +ifdef REQUIRE_PACKAGES_X11 +PACKAGEDIR_X11:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /x11/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_X11),) +ifneq ($(wildcard $(PACKAGEDIR_X11)/units/$(TARGETSUFFIX)),) +UNITDIR_X11=$(PACKAGEDIR_X11)/units/$(TARGETSUFFIX) +else +UNITDIR_X11=$(PACKAGEDIR_X11) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_X11)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_X11) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_X11)/$(FPCMADE) +endif +else +PACKAGEDIR_X11= +UNITDIR_X11:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /x11/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_X11),) +UNITDIR_X11:=$(firstword $(UNITDIR_X11)) +else +UNITDIR_X11= +endif +endif +ifdef UNITDIR_X11 +override COMPILER_UNITDIR+=$(UNITDIR_X11) +endif +endif +ifdef REQUIRE_PACKAGES_PTC +PACKAGEDIR_PTC:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /ptc/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_PTC),) +ifneq ($(wildcard $(PACKAGEDIR_PTC)/units/$(TARGETSUFFIX)),) +UNITDIR_PTC=$(PACKAGEDIR_PTC)/units/$(TARGETSUFFIX) +else +UNITDIR_PTC=$(PACKAGEDIR_PTC) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_PTC)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_PTC) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_PTC)/$(FPCMADE) +endif +else +PACKAGEDIR_PTC= +UNITDIR_PTC:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /ptc/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_PTC),) +UNITDIR_PTC:=$(firstword $(UNITDIR_PTC)) +else +UNITDIR_PTC= +endif +endif +ifdef UNITDIR_PTC +override COMPILER_UNITDIR+=$(UNITDIR_PTC) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(CPU_TARGET) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(CPU_TARGET) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifdef UNITDIR +override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) +endif +ifdef LIBDIR +override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) +endif +ifdef OBJDIR +override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) +endif +ifdef INCDIR +override FPCOPT+=$(addprefix -Fi,$(INCDIR)) +endif +ifdef LINKSMART +override FPCOPT+=-XX +endif +ifdef CREATESMART +override FPCOPT+=-CX +endif +ifdef DEBUG +override FPCOPT+=-gl +override FPCOPTDEF+=DEBUG +endif +ifdef RELEASE +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +endif +ifdef VERBOSE +override FPCOPT+=-vwni +endif +ifdef COMPILER_OPTIONS +override FPCOPT+=$(COMPILER_OPTIONS) +endif +ifdef COMPILER_UNITDIR +override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) +endif +ifdef COMPILER_LIBRARYDIR +override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) +endif +ifdef COMPILER_OBJECTDIR +override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) +endif +ifdef COMPILER_INCLUDEDIR +override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) +endif +ifdef CROSSBINDIR +override FPCOPT+=-FD$(CROSSBINDIR) +endif +ifdef COMPILER_TARGETDIR +override FPCOPT+=-FE$(COMPILER_TARGETDIR) +ifeq ($(COMPILER_TARGETDIR),.) +override TARGETDIRPREFIX= +else +override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ +endif +endif +ifdef COMPILER_UNITTARGETDIR +override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) +ifeq ($(COMPILER_UNITTARGETDIR),.) +override UNITTARGETDIRPREFIX= +else +override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ +endif +else +ifdef COMPILER_TARGETDIR +override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) +override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) +endif +endif +ifdef CREATESHARED +override FPCOPT+=-Cg +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-Aas +endif +endif +ifeq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),linux) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +endif +ifdef LINKSHARED +endif +ifdef GCCLIBDIR +override FPCOPT+=-Fl$(GCCLIBDIR) +endif +ifdef OTHERLIBDIR +override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR)) +endif +ifdef OPT +override FPCOPT+=$(OPT) +endif +ifdef FPCOPTDEF +override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) +endif +ifdef CFGFILE +override FPCOPT+=@$(CFGFILE) +endif +ifdef USEENV +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif +override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +endif +endif +.PHONY: fpc_exes +ifndef CROSSINSTALL +ifneq ($(TARGET_PROGRAMS),) +override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS)) +override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) +override ALLTARGET+=fpc_exes +override INSTALLEXEFILES+=$(EXEFILES) +override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES) +ifeq ($(OS_TARGET),os2) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +ifeq ($(OS_TARGET),emx) +override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS)) +endif +endif +endif +fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES) +ifdef TARGET_RSTS +override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) +override CLEANRSTFILES+=$(RSTFILES) +endif +.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared +$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) + @$(ECHOREDIR) Compiled > $(FPCMADE) +fpc_all: $(FPCMADE) +fpc_smart: + $(MAKE) all LINKSMART=1 CREATESMART=1 +fpc_debug: + $(MAKE) all DEBUG=1 +fpc_release: + $(MAKE) all RELEASE=1 +.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res +$(COMPILER_UNITTARGETDIR): + $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) +$(COMPILER_TARGETDIR): + $(MKDIRTREE) $(COMPILER_TARGETDIR) +%$(PPUEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(PPUEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.lpr + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.dpr + $(COMPILER) $< + $(EXECPPAS) +%.res: %.rc + windres -i $< -o $@ +vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall +ifdef INSTALL_UNITS +override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) +endif +ifdef INSTALL_BUILDUNIT +override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) +endif +ifdef INSTALLPPUFILES +override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) +ifneq ($(UNITTARGETDIRPREFIX),) +override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) +override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) +endif +override INSTALL_CREATEPACKAGEFPC=1 +endif +ifdef INSTALLEXEFILES +ifneq ($(TARGETDIRPREFIX),) +override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) +endif +endif +fpc_install: all $(INSTALLTARGET) +ifdef INSTALLEXEFILES + $(MKDIR) $(INSTALL_BINDIR) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILES) +endif + $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) +endif +ifdef INSTALL_CREATEPACKAGEFPC +ifdef FPCMAKE +ifdef PACKAGE_VERSION +ifneq ($(wildcard Makefile.fpc),) + $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) Package.fpc $(INSTALL_UNITDIR) +endif +endif +endif +endif +ifdef INSTALLPPUFILES + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) +ifneq ($(INSTALLPPULINKFILES),) + $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) +endif +ifneq ($(wildcard $(LIB_FULLNAME)),) + $(MKDIR) $(INSTALL_LIBDIR) + $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) +ifdef inUnix + ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) +endif +endif +endif +ifdef INSTALL_FILES + $(MKDIR) $(INSTALL_DATADIR) + $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) +endif +fpc_sourceinstall: distclean + $(MKDIR) $(INSTALL_SOURCEDIR) + $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) +fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) +ifdef HASEXAMPLES + $(MKDIR) $(INSTALL_EXAMPLEDIR) +endif +ifdef EXAMPLESOURCEFILES + $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) +endif +ifdef TARGET_EXAMPLEDIRS + $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) +endif +.PHONY: fpc_distinstall +fpc_distinstall: install exampleinstall +.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall +ifndef PACKDIR +ifndef inUnix +PACKDIR=$(BASEDIR)/../fpc-pack +else +PACKDIR=/tmp/fpc-pack +endif +endif +ifndef ZIPNAME +ifdef DIST_ZIPNAME +ZIPNAME=$(DIST_ZIPNAME) +else +ZIPNAME=$(PACKAGE_NAME) +endif +endif +ifndef FULLZIPNAME +FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX) +endif +ifndef ZIPTARGET +ifdef DIST_ZIPTARGET +ZIPTARGET=DIST_ZIPTARGET +else +ZIPTARGET=install +endif +endif +ifndef USEZIP +ifdef inUnix +USETAR=1 +endif +endif +ifndef inUnix +USEZIPWRAPPER=1 +endif +ifdef USEZIPWRAPPER +ZIPPATHSEP=$(PATHSEP) +ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT)) +else +ZIPPATHSEP=/ +endif +ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR)) +ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR)) +ifdef USETAR +ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT) +ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) * +else +ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT) +ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) * +endif +fpc_zipinstall: + $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1 + $(MKDIR) $(DIST_DESTDIR) + $(DEL) $(ZIPDESTFILE) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER) + $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER) +else + echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER) + echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER) + echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER) +endif +ifdef inUnix + /bin/sh $(ZIPWRAPPER) +else +ifdef RUNBATCH + $(RUNBATCH) (ZIPWRAPPER) +else + $(ZIPWRAPPER) +endif +endif + $(DEL) $(ZIPWRAPPER) +else + $(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE) +endif + $(DELTREE) $(PACKDIR) +fpc_zipsourceinstall: + $(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX) +fpc_zipexampleinstall: +ifdef HASEXAMPLES + $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX) +endif +fpc_zipdistinstall: + $(MAKE) fpc_zipinstall ZIPTARGET=distinstall +.PHONY: fpc_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +endif +ifdef CLEAN_UNITS +override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) +endif +ifdef CLEANPPUFILES +override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) +ifdef DEBUGSYMEXT +override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) +endif +override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) +override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) +endif +fpc_clean: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif +ifdef LIB_NAME + -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) +endif + -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) +fpc_cleanall: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef COMPILER_UNITTARGETDIR +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +endif + -$(DELTREE) units + -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) +ifneq ($(PPUEXT),.ppu) + -$(DEL) *.o *.ppu *.a +endif + -$(DELTREE) *$(SMARTEXT) + -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *_ppas$(BATCHEXT) +ifdef AOUTEXT + -$(DEL) *$(AOUTEXT) +endif +ifdef DEBUGSYMEXT + -$(DEL) *$(DEBUGSYMEXT) +endif +fpc_distclean: cleanall +.PHONY: fpc_baseinfo +override INFORULES+=fpc_baseinfo +fpc_baseinfo: + @$(ECHO) + @$(ECHO) == Package info == + @$(ECHO) Package Name..... $(PACKAGE_NAME) + @$(ECHO) Package Version.. $(PACKAGE_VERSION) + @$(ECHO) + @$(ECHO) == Configuration info == + @$(ECHO) + @$(ECHO) FPC.......... $(FPC) + @$(ECHO) FPC Version.. $(FPC_VERSION) + @$(ECHO) Source CPU... $(CPU_SOURCE) + @$(ECHO) Target CPU... $(CPU_TARGET) + @$(ECHO) Source OS.... $(OS_SOURCE) + @$(ECHO) Target OS.... $(OS_TARGET) + @$(ECHO) Full Source.. $(FULL_SOURCE) + @$(ECHO) Full Target.. $(FULL_TARGET) + @$(ECHO) SourceSuffix. $(SOURCESUFFIX) + @$(ECHO) TargetSuffix. $(TARGETSUFFIX) + @$(ECHO) + @$(ECHO) == Directory info == + @$(ECHO) + @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) + @$(ECHO) + @$(ECHO) Basedir......... $(BASEDIR) + @$(ECHO) FPCDir.......... $(FPCDIR) + @$(ECHO) CrossBinDir..... $(CROSSBINDIR) + @$(ECHO) UnitsDir........ $(UNITSDIR) + @$(ECHO) PackagesDir..... $(PACKAGESDIR) + @$(ECHO) + @$(ECHO) GCC library..... $(GCCLIBDIR) + @$(ECHO) Other library... $(OTHERLIBDIR) + @$(ECHO) + @$(ECHO) == Tools info == + @$(ECHO) + @$(ECHO) As........ $(AS) + @$(ECHO) Ld........ $(LD) + @$(ECHO) Ar........ $(AR) + @$(ECHO) Rc........ $(RC) + @$(ECHO) + @$(ECHO) Mv........ $(MVPROG) + @$(ECHO) Cp........ $(CPPROG) + @$(ECHO) Rm........ $(RMPROG) + @$(ECHO) GInstall.. $(GINSTALL) + @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) + @$(ECHO) Date...... $(DATE) + @$(ECHO) FPCMake... $(FPCMAKE) + @$(ECHO) PPUMove... $(PPUMOVE) + @$(ECHO) Upx....... $(UPXPROG) + @$(ECHO) Zip....... $(ZIPPROG) + @$(ECHO) + @$(ECHO) == Object info == + @$(ECHO) + @$(ECHO) Target Loaders........ $(TARGET_LOADERS) + @$(ECHO) Target Units.......... $(TARGET_UNITS) + @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) + @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) + @$(ECHO) Target Dirs........... $(TARGET_DIRS) + @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) + @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) + @$(ECHO) + @$(ECHO) Clean Units......... $(CLEAN_UNITS) + @$(ECHO) Clean Files......... $(CLEAN_FILES) + @$(ECHO) + @$(ECHO) Install Units....... $(INSTALL_UNITS) + @$(ECHO) Install Files....... $(INSTALL_FILES) + @$(ECHO) + @$(ECHO) == Install info == + @$(ECHO) + @$(ECHO) DateStr.............. $(DATESTR) + @$(ECHO) ZipName.............. $(ZIPNAME) + @$(ECHO) ZipPrefix............ $(ZIPPREFIX) + @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) + @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) + @$(ECHO) FullZipName.......... $(FULLZIPNAME) + @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) + @$(ECHO) + @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) + @$(ECHO) Install binary dir... $(INSTALL_BINDIR) + @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) + @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) + @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) + @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) + @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) + @$(ECHO) Install data dir..... $(INSTALL_DATADIR) + @$(ECHO) + @$(ECHO) Dist destination dir. $(DIST_DESTDIR) + @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) + @$(ECHO) +.PHONY: fpc_info +fpc_info: $(INFORULES) +.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ + fpc_makefile_dirs +fpc_makefile: + $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc +fpc_makefile_sub1: +ifdef TARGET_DIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) +endif +ifdef TARGET_EXAMPLEDIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) +endif +fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) +fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 +fpc_makefiles: fpc_makefile fpc_makefile_dirs +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: +shared: fpc_shared +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: fpc_distinstall +zipinstall: fpc_zipinstall +zipsourceinstall: fpc_zipsourceinstall +zipexampleinstall: fpc_zipexampleinstall +zipdistinstall: fpc_zipdistinstall +clean: fpc_clean +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +.NOTPARALLEL: diff --git a/packages/ptc/examples/Makefile.fpc b/packages/ptc/examples/Makefile.fpc new file mode 100644 index 0000000000..a32cdaf4eb --- /dev/null +++ b/packages/ptc/examples/Makefile.fpc @@ -0,0 +1,27 @@ +# +# Makefile.fpc for PTC examples +# + +[package] +name=ptc-examples +version=0.99.5 + +[target] +programs=area buffer clear clip con_info console fire \ + flower hicolor image keyboard keybrd2 land \ + lights modes mojo palette pixel random save \ + stretch texwarp timer tunnel3d tunnel + +[compiler] +unitdir=../$(UNITTARGETDIRPREFIX) + +[default] +fpcdir=../../.. + +[require] +packages=hermes ptc +packages_linux=x11 +packages_freebsd=x11 + +[rules] +.NOTPARALLEL: diff --git a/packages/ptc/examples/area.pp b/packages/ptc/examples/area.pp new file mode 100644 index 0000000000..48e11a9696 --- /dev/null +++ b/packages/ptc/examples/area.pp @@ -0,0 +1,100 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Area example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program AreaExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + format : TPTCFormat; + surface : TPTCSurface; + pixels : PDWord; + width, height : Integer; + i : Integer; + x, y, r, g, b : Integer; + area : TPTCArea; + +Begin + area := Nil; + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { create console } + console.open('Area example', format); + + { create surface half the size of the console } + surface := TPTCSurface.Create(console.width Div 2, console.height Div 2, format); + + { setup destination area } + x := console.width Div 4; + y := console.height Div 4; + area := TPTCArea.Create(x, y, x + surface.width, y + surface.height); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color } + r := Random(256); + g := Random(256); + b := Random(256); + + { draw color [r,g,b] at position [x,y] } + pixels[x + y * width] := (r Shl 16) + (g Shl 8) + b; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy surface to console destination area } + surface.copy(console, surface.area, area); + + { update console area } + console.update; + End; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + area.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/buffer.pp b/packages/ptc/examples/buffer.pp new file mode 100644 index 0000000000..de8728d6f3 --- /dev/null +++ b/packages/ptc/examples/buffer.pp @@ -0,0 +1,90 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Buffer example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program BufferExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + format : TPTCFormat; + palette : TPTCPalette; + width, height : Integer; + pixels : Pint32; + x, y, r, g, b : Integer; + i : Integer; + +Begin + pixels := Nil; + format := Nil; + palette := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Buffer example', format); + + { get console dimensions } + width := console.width; + height := console.height; + + { allocate a buffer of pixels } + pixels := GetMem(width * height * SizeOf(int32)); + palette := TPTCPalette.Create; + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color } + r := Random(256); + g := Random(256); + b := Random(256); + + { draw color [r,g,b] at position [x,y] } + pixels[x + y * width] := (r Shl 16) Or (g Shl 8) Or b; + End; + + { load pixels to console } + console.load(pixels, width, height, width * 4, format, palette); + + { update console } + console.update; + End; + Finally + { free pixels buffer } + If Assigned(pixels) Then + FreeMem(pixels); + console.close; + palette.Free; + format.Free; + console.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/clear.pp b/packages/ptc/examples/clear.pp new file mode 100644 index 0000000000..d63e4c1f82 --- /dev/null +++ b/packages/ptc/examples/clear.pp @@ -0,0 +1,81 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Clear example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program ClearExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + format : TPTCFormat; + surface : TPTCSurface; + width, height : Integer; + x, y : Integer; + size : Integer; + area : TPTCArea; + color : TPTCColor; + +Begin + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Clear example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { get surface dimensions } + width := surface.width; + height := surface.height; + + { get random position } + x := Random(width); + y := Random(height); + + { get random area size } + size := Random(width Div 8); + + { setup clear area } + area := TPTCArea.Create(x-size, y-size, x+size, y+size); + + { create random color } + color := TPTCColor.Create(Random, Random, Random); + + { clear surface area with color } + surface.clear(color, area); + + { copy to console } + surface.copy(console); + + { update console } + console.update; + area.Free; + color.Free; + End; + console.close; + console.Free; + surface.Free; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/clip.pp b/packages/ptc/examples/clip.pp new file mode 100644 index 0000000000..2104b912cb --- /dev/null +++ b/packages/ptc/examples/clip.pp @@ -0,0 +1,109 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Clip example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program ClipExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + area : TPTCArea; + x1, y1, x2, y2 : Integer; + pixels : Pint32; + width, height : Integer; + i : Integer; + x, y, r, g, b : Integer; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Clip example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { calculate clip coordinates } + x1 := console.width Div 4; + y1 := console.height Div 4; + x2 := console.width - x1; + y2 := console.height - y1; + + { setup clip area } + area := TPTCArea.Create(x1, y1, x2, y2); + Try + { set clip area } + console.clip(area); + Finally + area.Free; + End; + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color } + r := Random(256); + g := Random(256); + b := Random(256); + + { draw color [r,g,b] at position [x,y] } + pixels[x + y * width] := (r Shl 16) + (g Shl 8) + b; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + End; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/con_info.pp b/packages/ptc/examples/con_info.pp new file mode 100644 index 0000000000..86151ecc23 --- /dev/null +++ b/packages/ptc/examples/con_info.pp @@ -0,0 +1,78 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Info example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program InfoExample; + +{$MODE objfpc} + +Uses + ptc; + +Procedure print(Const format : TPTCFormat); + +Begin + { check format type } + If format.direct Then + { check alpha } + If format.a = 0 Then + { direct color format without alpha } + Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ')') + Else + { direct color format with alpha } + Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ',$', HexStr(format.a, 8), ')') + Else + { indexed color format } + Write('Format(', format.bits:2, ')'); +End; + +Var + console : TPTCConsole; + +Begin + console := Nil; + Try + Try + Writeln('[ptc version]'); + { print ptc version string define } + Writeln(PTC_VERSION); + Writeln; + + { create console } + console := TPTCConsole.Create; + + { open the console } + console.open('Info example'); + + { print console data } + Writeln('[console data]'); + Writeln('name = ', console.name); + Writeln('title = ', console.title); + Writeln('width = ', console.width); + Writeln('height = ', console.height); + Writeln('pages = ', console.pages); + Writeln('pitch = ', console.pitch); + Write('format = '); + print(console.format); + Writeln; + Writeln; + + { print console information } + Writeln('[console information]'); + Writeln(console.information); + Finally + console.close; + console.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/console.pp b/packages/ptc/examples/console.pp new file mode 100644 index 0000000000..642b1765f8 --- /dev/null +++ b/packages/ptc/examples/console.pp @@ -0,0 +1,119 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Console example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program ConsoleExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + palette : TPTCPalette; + data : Array[0..255] Of DWord; + i : Integer; + pixels : PByte; + width, height, pitch : Integer; + format : TPTCFormat; + bits, bytes : Integer; + x, y : Integer; + color : DWord; + pixel : PByte; + _data : PByte; + +Begin + Try + { create console } + console := TPTCConsole.Create; + + { open the console with one page } + console.open('Console example', 1); + + { create palette } + palette := TPTCPalette.Create; + + { generate palette } + For i := 0 To 255 Do + data[i] := i; + + { load palette data } + palette.load(data); + + { set console palette } + console.palette(palette); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock console } + pixels := console.lock; + + { get console dimensions } + width := console.width; + height := console.height; + pitch := console.pitch; + + { get console format } + format := console.format; + + { get format information } + bits := format.bits; + bytes := format.bytes; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { generate random color integer } + color := (Random(256) Shl 0) Or + (Random(256) Shl 8) Or + (Random(256) Shl 16) Or + (Random(256) Shl 24); + + { calculate pointer to pixel [x,y] } + pixel := pixels + y * pitch + x * bytes; + + { check bits } + Case bits Of + { 32 bits per pixel } + 32 : PDWord(pixel)^ := color; + 24 : Begin + { 24 bits per pixel } + _data := pixel; + _data[0] := (color And $000000FF) Shr 0; + _data[1] := (color And $0000FF00) Shr 8; + _data[2] := (color And $00FF0000) Shr 16; + End; + { 16 bits per pixel } + 16 : PWord(pixel)^ := color; + { 8 bits per pixel } + 8 : PByte(pixel)^ := color; + End; + End; + + { unlock console } + console.unlock; + + { update console } + console.update; + End; + palette.Free; + console.close; + console.Free; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/fire.pp b/packages/ptc/examples/fire.pp new file mode 100644 index 0000000000..4f5c647c99 --- /dev/null +++ b/packages/ptc/examples/fire.pp @@ -0,0 +1,265 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Fire demo for OpenPTC 1.0 C++ API + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is licensed under the GNU GPL +} + +Program Fire; + +{$MODE objfpc} + +Uses + ptc; + +Function pack(r, g, b : Uint32) : Uint32; + +Begin + { pack color integer } + pack := (r Shl 16) Or (g Shl 8) Or b; +End; + +Procedure generate(palette : TPTCPalette); + +Var + data : PUint32; + i, c : Integer; + +Begin + { lock palette data } + data := palette.lock; + + Try + { black to red } + i := 0; + c := 0; + While i < 64 Do + Begin + data[i] := pack(c, 0, 0); + Inc(c, 4); + Inc(i); + End; + + { red to yellow } + c := 0; + While i < 128 Do + Begin + data[i] := pack(255, c, 0); + Inc(c, 4); + Inc(i); + End; + + { yellow to white } + c := 0; + While i < {192}128 Do + Begin + data[i] := pack(255, 255, c); + Inc(c, 4); + Inc(i); + End; + + { white } + While i < 256 Do + Begin + data[i] := pack(255, 255, 255); + Inc(i); + End; + + Finally + { unlock palette } + palette.unlock; + End; +End; + +Var + format : TPTCFormat; + console : TPTCConsole; + surface : TPTCSurface; + palette : TPTCPalette; + state : Integer; + intensity : Single; + pixels, pixel, p : PUint8; + width, height : Integer; + x, y : Integer; + top, bottom, c1, c2 : Uint32; + generator : PUint8; + color : Integer; + area : TPTCArea; + +Begin + format := Nil; + console := Nil; + surface := Nil; + palette := Nil; + area := Nil; + Try + Try + { create format } + format := TPTCFormat.Create(8); + + { create console } + console := TPTCConsole.Create; + + { open console } + console.open('Fire demo', 320, 200, format); + + { create surface } + surface := TPTCSurface.Create(320, 208, format); + + { create palette } + palette := TPTCPalette.Create; + + { generate palette } + generate(palette); + + { set console palette } + console.palette(palette); + + { set surface palette } + surface.palette(palette); + + { flame data } + state := 0; + intensity := 0; + + { setup copy area } + area := TPTCArea.Create(0, 0, 320, 200); + + { main loop } + Repeat + { lower flame on keypress } + If console.KeyPressed Then + state := 2; + + { state machine } + Case state Of + 0 : Begin + { raise flame } + intensity += 0.007; + + { maximum flame height } + If intensity > 0.8 Then + state := 1; + End; + 1 : Begin + { constant flame } + End; + 2 : Begin + { lower flame } + intensity := intensity - 0.005; + + { exit program when flame is out } + If intensity < 0.01 Then + Begin + console.close; + Exit; + End; + End; + End; + + { lock surface pixels } + pixels := surface.lock; + + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { flame vertical loop } + y := 1; + While y < height - 4 Do + Begin + { current pixel pointer } + pixel := pixels + y * width; + + { flame horizontal loop } + For x := 0 To width - 1 Do + Begin + { sum top pixels } + p := pixel + (width Shl 1); + top := p^; + Inc(top, (p - 1)^); + Inc(top, (p + 1)^); + + { bottom pixel } + bottom := (pixel + (width Shl 2))^; + + { combine pixels } + c1 := (top + bottom) Shr 2; + If c1 > 1 Then + Dec(c1); + + { interpolate } + c2 := (c1 + bottom) Shr 1; + + { store pixels } + pixel^ := c1; + (pixel + width)^ := c2; + + { next pixel } + Inc(pixel); + End; + Inc(y, 2); + End; + + { setup flame generator pointer } + generator := pixels + width * (height - 4); + + { update flame generator bar } + x := 0; + While x < width Do + Begin + { random block color taking intensity into account } + color := random(Integer(Trunc(255 * intensity))); + + { write 4x4 color blocks } + (generator + 0)^ := color; + (generator + 1)^ := color; + (generator + 2)^ := color; + (generator + 3)^ := color; + (generator + width + 0)^ := color; + (generator + width + 1)^ := color; + (generator + width + 2)^ := color; + (generator + width + 3)^ := color; + (generator + width * 2 + 0)^ := color; + (generator + width * 2 + 1)^ := color; + (generator + width * 2 + 2)^ := color; + (generator + width * 2 + 3)^ := color; + (generator + width * 3 + 0)^ := color; + (generator + width * 3 + 1)^ := color; + (generator + width * 3 + 2)^ := color; + (generator + width * 3 + 3)^ := color; + + { next block } + Inc(generator, 4); + Inc(x, 4); + End; + + Finally + { unlock surface } + surface.unlock; + End; + + { copy surface to console } + surface.copy(console, area, area); + + { update console } + console.update; + Until False; + + Finally + console.Free; + surface.Free; + format.Free; + palette.Free; + area.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/flower.pp b/packages/ptc/examples/flower.pp new file mode 100644 index 0000000000..42d48d3762 --- /dev/null +++ b/packages/ptc/examples/flower.pp @@ -0,0 +1,240 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Flower demo for OpenPTC 1.0 C++ API + Copyright (c) Scott Buchanan (aka Goblin) + This source code is licensed under the GNU GPL +} + +Program Flower; + +{$MODE objfpc} + +Uses + ptc, Math; + +Function pack(r, g, b : Uint32) : Uint32; + +Begin + { pack color integer } + pack := (r Shl 16) Or (g Shl 8) Or b; +End; + +Procedure generate_flower(flower : TPTCSurface); + +Var + data : PUint8; + x, y, fx, fy, fx2, fy2 : Integer; + TWO_PI : Single; + +Begin + { lock surface } + data := flower.lock; + + Try + { surface width and height constants for cleaner code } + fx := flower.width; + fy := flower.height; + fx2 := fx Div 2; + fy2 := fy Div 2; + + { useful 2*pi constant } + TWO_PI := 2 * PI; + + { generate flower image } + For y := 0 To fy - 1 Do + For x := 0 To fx - 1 Do + data[x + y * fx] := Trunc(1.0 * Cos(18*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI + + 0.3 * Sin(15*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI + + Sqrt((y - fy2) * (y - fy2) + (x - fx2) * (x - fx2))) And $FF; + + { You might want to move the 1.0 and 0.3 and the 18 and the 15 + to parameters passed to the generate function... + the 1.0 and the 0.3 define the 'height' of the flower, while the + 18 and 15 control the number of 'petals' } + Finally + flower.unlock; + End; +End; + +Procedure generate(palette : TPTCPalette); + +Var + data : PUint32; + i, c : Integer; + +Begin + { lock palette data } + data := palette.lock; + + Try + { black to yellow } + i := 0; + c := 0; + While i < 64 Do + Begin + data[i] := pack(c, c, 0); + Inc(c, 4); + Inc(i); + End; + + { yellow to red } + c := 0; + While i < 128 Do + Begin + data[i] := pack(255, 255 - c, 0); + Inc(c, 4); + Inc(i); + End; + + { red to white } + c := 0; + While i < 192 Do + Begin + data[i] := pack(255, c, c); + Inc(c, 4); + Inc(i); + End; + + { white to black } + c := 0; + While i < 256 Do + Begin + data[i] := pack(255 - c, 255 - c, 255 - c); + Inc(c, 4); + Inc(i); + End; + Finally + { unlock palette } + palette.unlock; + End; +End; + +Var + console : TPTCConsole; + format : TPTCFormat; + flower_surface : TPTCSurface; + surface : TPTCSurface; + palette : TPTCPalette; + area : TPTCArea; + time, delta : Single; + scr, map : PUint8; + width, height, mapWidth : Integer; + xo, yo, xo2, yo2, xo3, yo3 : Single; + offset1, offset2, offset3 : Integer; + x, y : Integer; + +Begin + area := Nil; + format := Nil; + palette := Nil; + surface := Nil; + flower_surface := Nil; + console := Nil; + Try + Try + { create format } + format := TPTCFormat.Create(8); + + { create console } + console := TPTCConsole.Create; + + { create flower surface } + flower_surface := TPTCSurface.Create(640, 400, format); + + { generate flower } + generate_flower(flower_surface); + + { open console } + console.open('Flower demo', 320, 200, format); + + { create surface } + surface := TPTCSurface.Create(320, 200, format); + + { create palette } + palette := TPTCPalette.Create; + + { generate palette } + generate(palette); + + { set console palette } + console.palette(palette); + + { set surface palette } + surface.palette(palette); + + { setup copy area } + area := TPTCArea.Create(0, 0, 320, 200); + + { time data } + time := 0; + delta := 0.04; + + { main loop } + While Not console.KeyPressed Do + Begin + { lock surface pixels } + scr := surface.lock; + Try + map := flower_surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + mapWidth := flower_surface.width; + + xo := (width / 2) + 120 * sin(time * 1.1 + 1.5); + yo := (height / 2) + 90 * cos(time * 0.8 + 1.1); + offset1 := Trunc(xo) + Trunc(yo) * mapWidth; + + xo2 := (width / 2) + 120 * sin(time * 0.9 + 4.2); + yo2 := (height / 2) + 90 * cos(time * 0.7 + 6.9); + offset2 := Trunc(xo2) + Trunc(yo2) * mapWidth; + + xo3 := (width / 2) + 120 * sin(time * 0.9 + 3.1); + yo3 := (height / 2) + 90 * cos(time * 1.1 + 1.2); + offset3 := Trunc(xo3) + Trunc(yo3) * mapWidth; + + { vertical loop } + For y := 0 To height - 1 Do + { horizontal loop } + For x := 0 To width - 1 Do + scr[x + y * width] := (map[x + y * mapWidth + offset1] + + map[x + y * mapWidth + offset2] + + map[x + y * mapWidth + offset3]) And $FF; + Finally + { unlock surface } + flower_surface.unlock; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy surface to console } + surface.copy(console, area, area); + + { update console } + console.update; + + { update time } + time := time + delta; + End; + Finally + If Assigned(console) Then + console.close; + area.Free; + format.Free; + palette.Free; + surface.Free; + flower_surface.Free; + console.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/hicolor.pp b/packages/ptc/examples/hicolor.pp new file mode 100644 index 0000000000..30f1be3641 --- /dev/null +++ b/packages/ptc/examples/hicolor.pp @@ -0,0 +1,94 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + HiColor example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program HiColorExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + pixels : Pshort16; + width, height : Integer; + i : Integer; + x, y, r, g, b : Integer; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(16, $F800, $07E0, $001F); + + { open the console } + console.open('HiColor example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color } + r := Random(256); + g := Random(256); + b := Random(256); + + { draw color [r,g,b] at position [x,y] } + pixels[x + y * width] := ((r And $00F8) Shl 8) Or + ((g And $00FC) Shl 3) Or + ((b And $00F8) Shr 3); + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + End; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/image.pp b/packages/ptc/examples/image.pp new file mode 100644 index 0000000000..3117032865 --- /dev/null +++ b/packages/ptc/examples/image.pp @@ -0,0 +1,106 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Image example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program ImageExample; + +{$MODE objfpc} + +Uses + ptc; + +Procedure load(surface : TPTCSurface; filename : String); + +Var + F : File; + width, height : Integer; + pixels : PByte; + y : Integer; + tmp : TPTCFormat; + tmp2 : TPTCPalette; + +Begin + { open image file } + ASSign(F, filename); + Reset(F, 1); + + { skip header } + Seek(F, 18); + + { get surface dimensions } + width := surface.width; + height := surface.height; + + { allocate image pixels } + pixels := GetMem(width * height * 3); + + { read image pixels one line at a time } + For y := height - 1 DownTo 0 Do + BlockRead(F, pixels[width * y * 3], width * 3); + + { load pixels to surface } + tmp := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + tmp2 := TPTCPalette.Create; + surface.load(pixels, width, height, width * 3, tmp, tmp2); + tmp2.Free; + tmp.Free; + + { free image pixels } + FreeMem(pixels); +End; + +Var + console : TPTCConsole; + format : TPTCFormat; + surface : TPTCSurface; + +Begin + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + Try + { try to open the console matching the image resolution } + console.open('Image example', 320, 200, format); + Except + On TPTCError Do + { fallback to the default resolution } + console.open('Image example', format); + End; + + { create surface } + surface := TPTCSurface.Create(320, 200, format); + format.Free; + + { load image to surface } + load(surface, 'image.tga'); + + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + + { read key } + console.ReadKey; + + { close console } + console.close; + + console.Free; + surface.Free; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/image.tga b/packages/ptc/examples/image.tga Binary files differnew file mode 100644 index 0000000000..3ae321df8b --- /dev/null +++ b/packages/ptc/examples/image.tga diff --git a/packages/ptc/examples/keyboard.pp b/packages/ptc/examples/keyboard.pp new file mode 100644 index 0000000000..7396e90336 --- /dev/null +++ b/packages/ptc/examples/keyboard.pp @@ -0,0 +1,116 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Keyboard example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program KeyboardExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + color : TPTCColor; + key : TPTCKey; + area : TPTCArea; + x, y : Integer; + size : Integer; + delta : Integer; + +Begin + key := Nil; + color := Nil; + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create key } + key := TPTCKey.Create; + + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Keyboard example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { setup cursor data } + x := surface.width Div 2; + y := surface.height Div 2; + size := surface.width Div 10; + color := TPTCColor.Create(1, 1, 1); + + { main loop } + Repeat + { check for key press } + If console.KeyPressed Then + Begin + { read console key press } + console.ReadKey(key); + + { shift modifier } + If key.shift Then + { move fast } + delta := 10 + Else + { move slow } + delta := 1; + + { handle cursor keys } + Case key.code Of + PTCKEY_LEFT : Dec(x, delta); + PTCKEY_RIGHT : Inc(x, delta); + PTCKEY_UP : Dec(y, delta); + PTCKEY_DOWN : Inc(y, delta); + { exit when escape is pressed } + PTCKEY_ESCAPE : Break; + End; + End; + + { clear surface } + surface.clear; + + { setup cursor area } + area := TPTCArea.Create(x - size, y - size, x + size, y + size); + Try + { draw cursor as a quad } + surface.clear(color, area); + Finally + area.Free; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + Until False; + Finally + color.Free; + console.close; + console.Free; + surface.Free; + key.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/keybrd2.pp b/packages/ptc/examples/keybrd2.pp new file mode 100644 index 0000000000..53ed8e368f --- /dev/null +++ b/packages/ptc/examples/keybrd2.pp @@ -0,0 +1,120 @@ +Program KeyboardExample2; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + color : TPTCColor; + timer : TPTCTimer; + key : TPTCKey; + area : TPTCArea; + x, y, delta : Real; + left, right, up, down : Boolean; + size : Integer; + Done : Boolean; + +Begin + left := False; + right := False; + up := False; + down := False; + Try + Try + { create key } + key := TPTCKey.Create; + + { create console } + console := TPTCConsole.Create; + + { enable key release events } + console.KeyReleaseEnabled := True; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Keyboard example 2', format); + + { create timer } + timer := TPTCTimer.Create; + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { setup cursor data } + x := surface.width Div 2; + y := surface.height Div 2; + size := surface.width Div 10; + color := TPTCColor.Create(1, 1, 1); + + { start timer } + timer.start; + + { main loop } + Done := False; + Repeat + { check for key press/release } + While console.KeyPressed Do + Begin + console.ReadKey(key); + Case key.code Of + PTCKEY_LEFT : left := key.press; + PTCKEY_RIGHT : right := key.press; + PTCKEY_UP : up := key.press; + PTCKEY_DOWN : down := key.press; + PTCKEY_ESCAPE : Begin + Done := True; + Break; + End; + End; + End; + + { move square } + delta := timer.delta*100; + If left Then + x -= delta; + If right Then + x += delta; + If up Then + y -= delta; + If down Then + y += delta; + + { clear surface } + surface.clear; + + { setup cursor area } + area := TPTCArea.Create(Trunc(x) - size, Trunc(y) - size, Trunc(x) + size, Trunc(y) + size); + Try + { draw cursor as a quad } + surface.clear(color, area); + Finally + area.Free; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + Until Done; + Finally + color.Free; + console.close; + console.Free; + surface.Free; + key.Free; + timer.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/land.pp b/packages/ptc/examples/land.pp new file mode 100644 index 0000000000..930828c108 --- /dev/null +++ b/packages/ptc/examples/land.pp @@ -0,0 +1,402 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Land demo for OpenPTC 1.0 C++ API + + Based on Heightmap example from Hornet (RIP) + PTC version Copyright (c) 1998 Marcus Fletcher (cus@commsat.demon.co.uk) + + Updated to OpenPTC 1.0 by Glenn Fiedler (ptc@gaffer.org) + + Cursor keys to move, <Pause> to brake and <Esc> to quit +} + +Program Land; + +{$MODE objfpc} + +Uses + ptc; + +Const + SCREENWIDTH = 320; + SCREENHEIGHT = 200; + + FOV : Integer = 256; { half of the xy field of view (This is based on the 0-2048 convention) } + +Var + HMap : Array[0..256*256 - 1] Of Uint8; { Height field } + CMap : Array[0..256*256 - 1] Of Uint8; { Color map } + + lasty, { Last pixel drawn on a given column } + lastc : Array[0..SCREENWIDTH - 1] Of Integer; { Color of last pixel on a column } + CosT, SinT : Array[0..2047] Of Integer; { Cosine and Sine tables } + +{ Reduces a value to 0..255 (used in height field computation) } +Function Clamp(x : Integer) : Integer; + +Begin + If x < 0 Then + Clamp := 0 + Else + If x > 255 Then + Clamp := 255 + Else + Clamp := x; +End; + +{ Heightfield and colormap computation } +Procedure ComputeMap; + +Var + p, i, j, k, k2, p2, a, b, c, d : Integer; + +Begin + { Start from a plasma clouds fractal } + HMap[0] := 128; + p := 256; + While p > 1 Do + Begin + p2 := p Shr 1; + k := p * 8 + 20; + k2 := k Shr 1; + i := 0; + While i < 256 Do + Begin + j := 0; + While j < 256 Do + Begin + a := HMap[(i Shl 8) + j]; + b := HMap[(((i + p) And 255) Shl 8) + j]; + c := HMap[(i Shl 8) + ((j + p) And 255)]; + d := HMap[(((i + p) And 255) Shl 8) + ((j + p) And 255)]; + + HMap[(i Shl 8) + ((j + p2) And 255)] := + Clamp(((a + c) Shr 1) + (Random(k) - k2)); + HMap[(((i + p2) And 255) Shl 8) + ((j + p2) And 255)] := + Clamp(((a + b + c + d) Shr 2) + (Random(k) - k2)); + HMap[(((i + p2) And 255) Shl 8) + j] := + Clamp(((a + b) Shr 1) + (Random(k) - k2)); + Inc(j, p); + End; + Inc(i, p); + End; + p := p2; + End; + + { Smoothing } + For k := 0 To 2 Do + Begin + i := 0; + While i < 256*256 Do + Begin + For j := 0 To 255 Do + HMap[i + j] := (HMap[((i + 256) And $FF00) + j] + + HMap[i + ((j + 1) And $FF)] + + HMap[((i - 256) And $FF00) + j] + + HMap[i + ((j - 1) And $FF)]) Shr 2; + Inc(i, 256); + End; + End; + + { Color computation (derivative of the height field) } + i := 0; + While i < 256*256 Do + Begin + For j := 0 To 255 Do + Begin + k := 128 + (HMap[((i + 256) And $FF00) + ((j + 1) And 255)] - HMap[i + j])*4; + If k < 0 Then + k := 0; + If k > 255 Then + k := 255; + CMap[i + j] := k; + End; + Inc(i, 256); + End; +End; + +{ Calculate the lookup tables } +Procedure InitTables; + +Var + a : Integer; + result : Single; + +Begin + For a := 0 To 2047 Do + Begin + { Precalculate cosine } + result := cos(a * PI / 1024) * 256; + CosT[a] := Trunc(result); + + { and sine } + result := sin(a * PI / 1024) * 256; + SinT[a] := Trunc(result); + End; +End; + +{ + Draw a "section" of the landscape; x0,y0 and x1,y1 and the xy coordinates + on the height field, hy is the viewpoint height, s is the scaling factor + for the distance. x0,y0,x1,y1 are 16.16 fixed point numbers and the + scaling factor is a 16.8 fixed point value. +} +Procedure Line(x0, y0, x1, y1, hy, s : Integer; surface_buffer : PUint32; fadeout : Integer); + +Var + sx, sy, i, a, b, u0, u1, v0, v1, h0, h1, h2, h3, h, c, y : Integer; + coord_x, coord_y, sc, cc, currentColor : Integer; + pixel : PUint32; + +Begin + { Compute xy speed } + sx := (x1 - x0) Div SCREENWIDTH; + sy := (y1 - y0) Div SCREENWIDTH; + + For i := 0 To SCREENWIDTH - 1 Do + Begin + { Compute the xy coordinates; a and b will be the position inside the } + { single map cell (0..255). } + a := (x0 Shr 8) And $FF; + b := (y0 Shr 8) And $FF; + + u0 := (x0 Shr 16) And $FF; + u1 := (u0 + 1) And $FF; + v0 := (y0 Shr 8) And $FF00; + v1 := (v0 + 256) And $FF00; + + { Fetch the height at the four corners of the square the point is in } + h0 := HMap[u0 + v0]; + h1 := HMap[u1 + v0]; + h2 := HMap[u0 + v1]; + h3 := HMap[u1 + v1]; + + { Compute the height using bilinear interpolation } + h0 := (h0 Shl 8) + a * (h1 - h0); + h2 := (h2 Shl 8) + a * (h3 - h2); + h := ((h0 Shl 8) + b * (h2 - h0)) Shr 16; + + { Fetch the color at the centre of the square the point is in } + h0 := CMap[u0 + v0]; + h1 := CMap[u1 + v0]; + h2 := CMap[u0 + v1]; + h3 := CMap[u1 + v1]; + + { Compute the color using bilinear interpolation (in 16.16) } + h0 := (h0 Shl 8) + a * (h1 - h0); + h2 := (h2 Shl 8) + a * (h3 - h2); + c := ((h0 Shl 8) + b * (h2 - h0)); + + { Compute screen height using the scaling factor } + y := (((h - hy) * s) Shr 11) + (SCREENHEIGHT Shr 1); + + { Draw the column } + a := lasty[i]; + If y < a Then + Begin + coord_x := i; + coord_y := a; + If lastc[i] = -1 Then + lastc[i] := c; + + sc := (c - lastc[i]) Div (a - y); + cc := lastc[i]; + + If a > (SCREENHEIGHT - 1) Then + Begin + Dec(coord_y, a - (SCREENHEIGHT - 1)); + a := SCREENHEIGHT - 1; + End; + If y < 0 Then + y := 0; + + While y < a Do + Begin + currentColor := cc Shr 18; + pixel := surface_buffer + (coord_y * SCREENWIDTH) + coord_x; + pixel^ := ((currentColor Shl 2) * (150 - fadeout) Div 150) Shl 8; + Inc(cc, sc); + Dec(coord_y); + Dec(a); + End; + lasty[i] := y; + End; + lastc[i] := c; + + { Advance to next xy position } + Inc(x0, sx); Inc(y0, sy); + End; +End; + +{ Draw the view from the point x0,y0 (16.16) looking at angle a } +Procedure View(x0, y0, angle, height : Integer; surface_buffer : PUint32); + +Var + d, u0, a, v0, u1, v1, h0, h1, h2, h3 : Integer; + +Begin + { Initialize last-y and last-color arrays } + For d := 0 To SCREENWIDTH - 1 Do + Begin + lasty[d] := SCREENHEIGHT; + lastc[d] := -1; + End; + + { Compute the xy coordinates; a and b will be the position inside the } + { single map cell (0..255). } + u0 := (x0 Shr 16) And $FF; + a := (x0 Shr 8) And $FF; + v0 := (y0 Shr 8) And $FF00; + u1 := (u0 + 1) And $FF; + v1 := (v0 + 256) And $FF00; + + { Fetch the height at the four corners of the square the point is in } + h0 := HMap[u0 + v0]; + h1 := HMap[u1 + v0]; + h2 := HMap[u0 + v1]; + h3 := HMap[u1 + v1]; + + { Compute the height using bilinear interpolation } + h0 := (h0 Shl 8) + a * (h1 - h0); + h2 := (h2 Shl 8) + a * (h3 - h2); + + { Draw the landscape from near to far without overdraw } + d := 0; + While d < 150 Do + Begin + Line(x0 + (d Shl 8)*CosT[(angle - FOV) And $7FF], + y0 + (d Shl 8)*SinT[(angle - FOV) And $7FF], + x0 + (d Shl 8)*CosT[(angle + FOV) And $7FF], + y0 + (d Shl 8)*SinT[(angle + FOV) And $7FF], + height, (100 Shl 8) Div (d + 1), + surface_buffer, + d); + Inc(d, 1 + (d Shr 6)); + End; +End; + +Var + format : TPTCFormat; + console : TPTCConsole; + surface : TPTCSurface; + timer : TPTCTimer; + key : TPTCKeyEvent; + pixels : PUint32; + Done : Boolean; + + x0, y0 : Integer; + height : Integer; + angle, deltaAngle, deltaSpeed, CurrentSpeed, scale, delta : Double; + index : Integer; + +Begin + Done := False; + format := Nil; + console := Nil; + surface := Nil; + timer := Nil; + key := Nil; + Try + Try + key := TPTCKeyEvent.Create; + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + console := TPTCConsole.Create; + console.open('Land demo', SCREENWIDTH, SCREENHEIGHT, format); + surface := TPTCSurface.Create(SCREENWIDTH, SCREENHEIGHT, format); + + { Compute the height map } + ComputeMap; + InitTables; + + x0 := 0; + y0 := 0; + + height := -200; + angle := 0; + deltaAngle := 0; + deltaSpeed := 4096; + CurrentSpeed := deltaSpeed * 10; + + { time scaling constant } + scale := 20; + + { create timer } + timer := TPTCTimer.Create; + + { start timer } + timer.start; + + { main loop } + Repeat + { get time delta between frames } + delta := timer.delta; + + { clear surface } + surface.clear; + + { lock surface pixels } + pixels := surface.lock; + Try + { draw current landscape view } + View(x0, y0, Trunc(angle), height, pixels); + Finally + { unlock surface } + surface.unlock; + End; + + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + + { check key press } + While console.KeyPressed Do + Begin + { read key press } + console.ReadKey(key); + + { handle key press } + Case key.code Of + { increase speed } + PTCKEY_UP : CurrentSpeed += deltaSpeed * delta * scale; + { decrease speed } + PTCKEY_DOWN : CurrentSpeed -= deltaSpeed * delta * scale; + { turn to the left } + PTCKEY_LEFT : deltaAngle -= 1; + { turn to the right } + PTCKEY_RIGHT : deltaAngle += 1; + PTCKEY_SPACE : Begin + { stop moving } + CurrentSpeed := 0; + deltaAngle := 0; + End; + { exit } + PTCKEY_ESCAPE : Done := True; + End; + End; + + { Update position/angle } + angle += deltaAngle * delta * scale; + + index := Trunc(angle) And $7FF; + Inc(x0, Trunc(CurrentSpeed * CosT[index]) Div 256); + Inc(y0, Trunc(CurrentSpeed * SinT[index]) Div 256); + Until Done; + Finally + console.close; + console.Free; + surface.Free; + timer.Free; + format.Free; + key.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/lights.pp b/packages/ptc/examples/lights.pp new file mode 100644 index 0000000000..74acca956b --- /dev/null +++ b/packages/ptc/examples/lights.pp @@ -0,0 +1,290 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Lights demo for OpenPTC 1.0 C++ API + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is licensed under the GNU GPL +} + +Program Lights; + +{$MODE objfpc} + +Uses + ptc; + +Var + { distance lookup table } + distance_table : Array[0..299, 0..511] Of DWord; { note: 16.16 fixed } + +{ intensity calculation } +Function CalcIntensity(dx, dy : Integer; i : DWord) : DWord;{ Inline;} + +Begin + { lookup intensity at [dx,dy] } + CalcIntensity := i * distance_table[dy, dx]; +End; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + palette : TPTCPalette; + dx, dy : Integer; + divisor : Single; + data : PUint32; + pixels, line : PUint8; + width : Integer; + i : Integer; + x, y, x1, y1, x2, y2, x3, y3, x4, y4 : Integer; + cx1, cy1, cx2, cy2, cx3, cy3, cx4, cy4 : Single; + dx1, dy1, dx2, dy2, dx3, dy3, dx4, dy4 : Single; + _dx1, _dx2, _dx3, _dx4 : Integer; + _dy1, _dy2, _dy3, _dy4 : Integer; + ix1, ix2, ix3, ix4 : Integer; + i1, i2, i3, i4 : DWord; + length : Integer; + move_t, move_dt, move_ddt : Single; + flash_t, flash_dt, flash_ddt : Single; + intensity : DWord; + max_intensity, max_intensity_inc : Single; + +Begin + console := Nil; + format := Nil; + surface := Nil; + palette := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + format := TPTCFormat.Create(8); + + { open console } + console.open('Lights demo', 320, 200, format); + + { create surface } + surface := TPTCSurface.Create(320, 200, format); + + { setup intensity table } + For dy := 0 To 199 Do + For dx := 0 To 511 Do + Begin + divisor := sqrt((dx * dx) + (dy * dy)); + If divisor < 0.3 Then + divisor := 0.3; + distance_table[dy, dx] := Trunc(65535 / divisor); + End; + + { create palette } + palette := TPTCPalette.Create; + + { generate greyscale palette } + data := palette.lock; + Try + For i := 0 To 255 Do + data[i] := (i Shl 16) Or (i Shl 8) Or i; + Finally + palette.unlock; + End; + + { set console palette } + console.palette(palette); + + { set surface palette } + surface.palette(palette); + + { data } + cx1 := 60; + cy1 := 110; + cx2 := 100; + cy2 := 80; + cx3 := 250; + cy3 := 110; + cx4 := 200; + cy4 := 90; + dx1 := 0; + dy1 := 0; + dx2 := 0; + dy2 := 0; + dx3 := 0; + dy3 := 0; + dx4 := 0; + dy4 := 0; + i1 := 0; + i2 := 0; + i3 := 0; + i4 := 0; + + { time data } + move_t := 0.3; + move_dt := 0.1; + move_ddt := 0.0006; + flash_t := 0.1; + flash_dt := 0.0; + flash_ddt := 0.0004; + + { control data } + max_intensity := 30; + max_intensity_inc := 0.2; + + { main loop } + While Not console.KeyPressed Do + Begin + { source positions } + x1 := Trunc(cx1 + dx1); + y1 := Trunc(cy1 + dy1); + x2 := Trunc(cx2 + dx2); + y2 := Trunc(cy2 + dy2); + x3 := Trunc(cx3 + dx3); + y3 := Trunc(cy3 + dy3); + x4 := Trunc(cx4 + dx4); + y4 := Trunc(cy4 + dy4); + + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + + { line loop } + For y := 0 To 199 Do + Begin + { calcalate pointer to start of line } + line := pixels + y * width; + + { get y deltas } + _dy1 := abs(y - y1); + _dy2 := abs(y - y2); + _dy3 := abs(y - y3); + _dy4 := abs(y - y4); + + { setup x } + x := 0; + + { line loop } + While x < width Do + Begin + { get x deltas } + _dx1 := abs(x1 - x); + _dx2 := abs(x2 - x); + _dx3 := abs(x3 - x); + _dx4 := abs(x4 - x); + + { get increments } + ix1 := 1; + ix2 := 1; + ix3 := 1; + ix4 := 1; + If x1 > x Then + ix1 := -1; + If x2 > x Then + ix2 := -1; + If x3 > x Then + ix3 := -1; + If x4 > x Then + ix4 := -1; + + { set span length to min delta } + length := width - x; + If (x1 > x) And (_dx1 < length) Then + length := _dx1; + If (x2 > x) And (_dx2 < length) Then + length := _dx2; + If (x3 > x) And (_dx3 < length) Then + length := _dx3; + If (x4 > x) And (_dx4 < length) Then + length := _dx4; + + { pixel loop } + While length > 0 Do + Begin + Dec(length); + { calc intensities } + intensity := CalcIntensity(_dx1, _dy1, i1); + Inc(intensity, CalcIntensity(_dx2, _dy2, i2)); + Inc(intensity, CalcIntensity(_dx3, _dy3, i3)); + Inc(intensity, CalcIntensity(_dx4, _dy4, i4)); + intensity := intensity Shr 16; + If intensity > 255 Then + intensity := 255; + + { update deltas } + Inc(_dx1, ix1); + Inc(_dx2, ix2); + Inc(_dx3, ix3); + Inc(_dx4, ix4); + + { store the pixel } + line[x] := intensity; + Inc(x); + End; + End; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { move the lights around } + dx1 := 50 * sin((move_t + 0.0) * 0.10); + dy1 := 80 * sin((move_t + 0.6) * 0.14); + dx2 := 100 * sin((move_t + 0.1) * 0.10); + dy2 := 30 * sin((move_t - 0.4) * 0.30); + dx3 := 39 * sin((move_t + 9.9) * 0.20); + dy3 := 50 * sin((move_t + 0.4) * 0.30); + dx4 := 70 * sin((move_t - 0.3) * 0.25); + dy4 := 40 * sin((move_t - 0.1) * 0.31); + + { flash intensity } + i1 := Trunc(max_intensity * (sin((flash_t + 0.000) * 1.000) + 1)); + i2 := Trunc(max_intensity * (sin((flash_t + 2.199) * 0.781) + 1)); + i3 := Trunc(max_intensity * (sin((flash_t - 1.450) * 1.123) + 1)); + i4 := Trunc(max_intensity * (sin((flash_t + 0.000) * 0.500) + 1)); + + { update time } + move_t := move_t + move_dt; + move_dt := move_dt + move_ddt; + flash_t := flash_t + flash_dt; + flash_dt := flash_dt + flash_ddt; + + { reset on big flash... } + If (move_t > 600) And (i1 > 10000) And (i2 > 10000) And + (i3 > 10000) And (i4 > 10000) Then + Begin + move_t := 0.3; + move_dt := 0.1; + move_ddt := 0.0006; + flash_t := 0.1; + flash_dt := 0.0; + flash_ddt := 0.0004; + max_intensity := 0.0; + max_intensity_inc := 0.2; + End; + + { update intensity } + max_intensity := max_intensity + max_intensity_inc; + max_intensity_inc := max_intensity_inc + 0.008; + + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + End; + Finally + console.close; + surface.Free; + console.Free; + palette.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/modes.pp b/packages/ptc/examples/modes.pp new file mode 100644 index 0000000000..bd8ee551ba --- /dev/null +++ b/packages/ptc/examples/modes.pp @@ -0,0 +1,100 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Modes example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program ModesExample; + +{$MODE objfpc} + +Uses + ptc; + +Procedure print(Const format : TPTCFormat); + +Begin + { check format type } + If format.direct Then + { check alpha } + If format.a = 0 Then + { direct color format without alpha } + Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ')') + Else + { direct color format with alpha } + Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ',$', HexStr(format.a, 8), ')') + Else + { indexed color format } + Write('Format(', format.bits:2, ')'); +End; + +Procedure print(Const mode : TPTCMode); + +Begin + { print mode width and height } + Write(' ', mode.width:4, ' x ', mode.height); + If mode.height < 1000 Then + Write(' '); + If mode.height < 100 Then + Write(' '); + If mode.height < 10 Then + Write(' '); + Write(' x '); + + { print mode format } + print(mode.format); + + { newline } + Writeln; +End; + +Var + console : TPTCConsole; + modes : PPTCMode; + index : Integer; + +Begin + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { get list of console modes } + modes := console.modes; + + { check for empty list } + If Not modes[0].valid Then + { the console mode list was empty } + Writeln('[console mode list is not available]') + Else + Begin + { print mode list header } + Writeln('[console modes]'); + + { mode index } + index := 0; + + { iterate through all modes } + While modes[index].valid Do + Begin + { print mode } + print(modes[index]); + + { next mode } + Inc(index); + End; + End; + Finally + console.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/mojo.pp b/packages/ptc/examples/mojo.pp new file mode 100644 index 0000000000..a6fcc285a3 --- /dev/null +++ b/packages/ptc/examples/mojo.pp @@ -0,0 +1,815 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ +Mojo demo for OpenPTC 1.0 C++ API +Coded by Alex Evans and adapted to OpenPTC 1.0 by Glenn Fiedler + +nasty code by alex "statix" evans for ptc. (c) copyright alex evans 1998 +time... 02.00 am on 13/1/98. +have fun +it's my take on some classic light mask effect +it's raytracing through properly modelled fog with occlusion, multiple +shadow rays cast back to the light for each pixel ray, and erm, its +s l o w... but it looks nice don't it? + +oh and fresnel fall off... or something + +UNTESTED! ok? + +define inv for interesting fx (not) +} + +Program Mojo; + +{$MODE objfpc} + +Uses + ptc, SysUtils; + +{ $DEFINE INV} + +Const + SC = 12; + MINSEGSIZE = 2.5; + NSEG = 5; + frandtab_seed : Uint16 = 54; + +Var + MaskMap : PUint8; + frandtab : Array[0..65535] Of Uint16; + +Type + FVector = Object +{ Case Boolean Of + False : (X, Y, Z : Single); + True : (R, G, B : Single);} + X, Y, Z : Single; + + Constructor Init; + Constructor Init(_x, _y, _z : Single); + + Function Magnitude : Single; + Function MagnitudeSq : Single; + Procedure Normalise; + End; + FMatrix = Object + Row : Array[0..2] Of FVector; + Constructor Init; + Constructor Init(a, b, c : FVector); + Function Column0 : FVector; + Function Column1 : FVector; + Function Column2 : FVector; + Procedure MakeXRot(theta : Single); + Procedure MakeYRot(theta : Single); + Procedure MakeZRot(theta : Single); + Procedure MakeID; + Function Transpose : FMatrix; + Procedure TransposeInPlace; + Procedure Normalise; + End; + PRay = ^TRay; + TRay = Object + mPosn : FVector; + mDir : FVector; + Constructor Init(Const p, d : FVector); + End; + VLight = Class(TObject) + mAng : Single; + mPosn : FVector; + mTarget : FVector; + mAxis : FMatrix; + mCol : FVector; + + p, p2, _d : FVector; { temp space } + + Constructor Create(Const col : FVector); + Procedure Move(Const q : FVector); + Procedure MoveT(Const q : FVector); + Procedure Update; + Function Light(Const ray : TRay) : FVector; + Function CalcLight(t : Single) : Single; + End; + +Constructor FVector.Init; + +Begin +End; + +Constructor FVector.Init(_x, _y, _z : Single); + +Begin + X := _x; + Y := _y; + Z := _z; +End; + +Function FVector.Magnitude : Single; + +Begin + Magnitude := Sqrt(Sqr(X) + Sqr(Y) + Sqr(Z)); +End; + +Function FVector.MagnitudeSq : Single; + +Begin + MagnitudeSq := Sqr(X) + Sqr(Y) + Sqr(Z); +End; + +Procedure FVector.Normalise; + +Var + l : Single; + +Begin + l := 1 / Magnitude; + X *= l; + Y *= l; + Z *= l; +End; + +Operator * (a, b : FVector) res : Single; + +Begin + res := a.X * b.X + a.Y * b.Y + a.Z * b.Z; +End; + +Operator * (a : FVector; b : Single) res : FVector; + +Begin + res.X := a.X * b; + res.Y := a.Y * b; + res.Z := a.Z * b; +End; + +Operator + (a, b : FVector) res : FVector; + +Begin + res.X := a.X + b.X; + res.Y := a.Y + b.Y; + res.Z := a.Z + b.Z; +End; + +Operator - (a, b : FVector) res : FVector; + +Begin + res.X := a.X - b.X; + res.Y := a.Y - b.Y; + res.Z := a.Z - b.Z; +End; + +Operator ** (a, b : FVector) res : FVector; + +Begin + res.X := a.Y * b.Z - a.Z * b.Y; + res.Y := a.Z * b.X - a.X * b.Z; + res.Z := a.X * b.Y - a.Y * b.X; +End; + +Constructor FMatrix.Init; + +Begin +End; + +Constructor FMatrix.Init(a, b, c : FVector); + +Begin + Row[0] := a; + Row[1] := b; + Row[2] := c; +End; + +Function FMatrix.Column0 : FVector; + +Var + res : FVector; + +Begin + res.Init(Row[0].X, Row[1].X, Row[2].X); + Column0 := res; +End; + +Function FMatrix.Column1 : FVector; + +Var + res : FVector; + +Begin + res.Init(Row[0].Y, Row[1].Y, Row[2].Y); + Column1 := res; +End; + +Function FMatrix.Column2 : FVector; + +Var + res : FVector; + +Begin + res.Init(Row[0].Z, Row[1].Z, Row[2].Z); + Column2 := res; +End; + +Procedure FMatrix.MakeXRot(theta : Single); + +Var + c, s : Single; + +Begin + c := cos(theta); + s := sin(theta); + Row[1].Y := c; Row[1].Z := s; Row[1].X := 0; + Row[2].Y := -s; Row[2].Z := c; Row[2].X := 0; + Row[0].Y := 0; Row[0].Z := 0; Row[0].X := 1; +End; + +Procedure FMatrix.MakeYRot(theta : Single); + +Var + c, s : Single; + +Begin + c := cos(theta); + s := sin(theta); + Row[2].Z := c; Row[2].X := s; Row[2].Y := 0; + Row[0].Z := -s; Row[0].X := c; Row[0].Y := 0; + Row[1].Z := 0; Row[1].X := 0; Row[1].Y := 1; +End; + +Procedure FMatrix.MakeZRot(theta : Single); + +Var + c, s : Single; + +Begin + c := cos(theta); + s := sin(theta); + Row[0].X := c; Row[0].Y := s; Row[0].Z := 0; + Row[1].X := -s; Row[1].Y := c; Row[1].Z := 0; + Row[2].X := 0; Row[2].Y := 0; Row[2].Z := 1; +End; + +Procedure FMatrix.MakeID; + +Begin + Row[0].Init(1, 0, 0); + Row[1].Init(0, 1, 0); + Row[2].Init(0, 0, 1); +End; + +Function FMatrix.Transpose : FMatrix; + +Var + res : FMatrix; + +Begin + res.Init(Column0, Column1, Column2); + Transpose := res; +End; + +Procedure FMatrix.TransposeInPlace; + +Begin + Init(Column0, Column1, Column2); +End; + +Procedure FMatrix.Normalise; + +Begin + Row[2].Normalise; + Row[0] := Row[1]**Row[2]; + Row[0].Normalise; + Row[1] := Row[2]**Row[0]; + Row[1].Normalise; +End; + +Operator * (Const m : FMatrix; Const a : Single) res : FMatrix; + +Begin + res.Init(m.Row[0]*a, m.Row[1]*a, m.Row[2]*a); +End; + +Operator * (Const m, a : FMatrix) res : FMatrix; + +Var + v1, v2, v3 : FVector; + +Begin + v1.Init(m.Row[0].X*a.Row[0].X+m.Row[0].Y*a.Row[1].X+m.Row[0].Z*a.Row[2].X, + m.Row[0].X*a.Row[0].Y+m.Row[0].Y*a.Row[1].Y+m.Row[0].Z*a.Row[2].Y, + m.Row[0].X*a.Row[0].Z+m.Row[0].Y*a.Row[1].Z+m.Row[0].Z*a.Row[2].Z); + v2.Init(m.Row[1].X*a.Row[0].X+m.Row[1].Y*a.Row[1].X+m.Row[1].Z*a.Row[2].X, + m.Row[1].X*a.Row[0].Y+m.Row[1].Y*a.Row[1].Y+m.Row[1].Z*a.Row[2].Y, + m.Row[1].X*a.Row[0].Z+m.Row[1].Y*a.Row[1].Z+m.Row[1].Z*a.Row[2].Z); + v3.Init(m.Row[2].X*a.Row[0].X+m.Row[2].Y*a.Row[1].X+m.Row[2].Z*a.Row[2].X, + m.Row[2].X*a.Row[0].Y+m.Row[2].Y*a.Row[1].Y+m.Row[2].Z*a.Row[2].Y, + m.Row[2].X*a.Row[0].Z+m.Row[2].Y*a.Row[1].Z+m.Row[2].Z*a.Row[2].Z); + res.Init(v1, v2, v3); +End; + +Operator * (Const m : FMatrix; Const a : FVector) res : FVector; + +Begin + res.Init(a*m.Row[0], a*m.Row[1], a*m.Row[2]); +End; + +Operator + (Const m, a : FMatrix) res : FMatrix; + +Begin + res.Init(m.Row[0]+a.Row[0], m.Row[1]+a.Row[1], m.Row[2]+a.Row[2]); +End; + +Operator - (Const m, a : FMatrix) res : FMatrix; + +Begin + res.Init(m.Row[0]+a.Row[0], m.Row[1]+a.Row[1], m.Row[2]+a.Row[2]); +End; + +Constructor TRay.Init(Const p, d : FVector); + +Begin + mPosn := p; + mDir := d; + mDir.Normalise; +End; + +Constructor VLight.Create(Const col : FVector); + +Begin + mCol := col * 0.9; + mAng := 2.8; + mPosn.Init(0, 0, 20); + mTarget.Init(0, 0, 0.1); + mAxis.MakeID; + Update; +End; + +Procedure VLight.Move(Const q : FVector); + +Begin + mPosn := q; + Update; +End; + +Procedure VLight.MoveT(Const q : FVector); + +Begin + mTarget := q; + Update; +End; + +Procedure VLight.Update; + +Begin + mAxis.Row[2] := (mTarget - mPosn); + mAxis.Normalise; +End; + +Function VLight.Light(Const ray : TRay) : FVector; + +Var + f, A, B, C, D, t1, t2, t3, fr, l1, l2, t, h : Single; + frc, x, y, q : Integer; + pp : FVector; + res : FVector; + +Begin + f := 0; + + p2 := ray.mPosn; + p := mAxis * (ray.mPosn - mPosn); + _d := mAxis * ray.mDir; + A := (_d.X*_d.X+_d.Y*_d.Y); + B := 2*(_d.X*p.X+_d.Y*p.Y)-mAng*(_d.Z); + C := (p.X*p.X+p.Y*p.Y)-mAng*(p.Z); + D := B*B-4*A*C; + If D <= 0 Then + Begin + res.Init(0, 0, 0); + Light := res; + Exit; + End; + D := Sqrt(D); + A *= 2; + t1 := (-B-D)/A; + t2 := (-B+D)/A; + frc := 255; + t3 := -ray.mPosn.Z/ray.mDir.Z; + If t2<=0 Then + Begin + res.Init(0, 0, 0); + Light := res; + Exit; + End; + If t1<0 Then + t1 := 0; + If t3>0 Then + Begin + { clip to bitmap plane } + pp := ray.mPosn + ray.mDir*t3; + x := 160+Trunc(SC*pp.X); +{$IFNDEF INV} + If (x>=0) And (x<=319) Then + Begin + y := 100 + Trunc(SC*pp.Y); + If (y>=0) And (y<=199) Then + Begin + {res.Init(0, 0, 1); + Light := res; + Exit;} + frc := MaskMap[y*320+x]; + If frc<1 Then + Begin + If t1>t3 Then + t1 := t3; + If t2>t3 Then + t2 := t3; + End; + End + Else + t3 := t2 + End + Else + t3 := t2; +{$ELSE} + If (x >= 0) And (x <= 319) Then + Begin + y := 100 + Trunc(SC*pp.Y); + If (y >= 0) And (y <= 199) And (MaskMap[y*320 + x] < 128) Then + t3 := t2; + End; + If t1 > t3 Then + t1 := t3; + If t2 > t3 Then + t2 := t3; +{$ENDIF} + End; + If t1>=t2 Then + Begin + res.Init(0, 0, 0); + Light := res; + Exit; + End; + fr := frc/255; + l1 := CalcLight(t1); + If t1>t3 Then + l1 *= fr; + q := NSEG; + t := t1; + h := (t2-t1)/NSEG; + If h<MINSEGSIZE Then + h := MINSEGSIZE; + While (t<t3) And (q>0) And (t<t2) Do + Begin + t += h; + If (t>t2) Then + Begin + h -= t2-t; + t := t2; + q := 0; + End + Else + Dec(q); + h := (t-t1); + p += _d*h; + p2 += ray.mDir*h; + l2 := CalcLight(t); + f += (l1+l2)*h; + l1 := l2; + t1 := t; + End; + While (q>0) And (t<t2) Do + Begin + t += h; + If t>t2 Then + Begin + h -= t2-t; + t := t2; + q := 0; + End + Else + Dec(q); + p += _d*h; + p2 += ray.mDir*h; + l2 := CalcLight(t); + If t>t3 Then + l2 *= fr; + f += (l1+l2)*h; + l1 := l2; + t1 := t; + End; + Light := mCol*f; +End; + +Function VLight.CalcLight(t : Single) : Single; + +Var + f : Single; + x, y, c : Integer; + +Begin + { trace line to bitmap from mPosn to p2 } + If Not ((mPosn.Z > 0) Xor (p2.Z > 0)) Then + Begin + { fresnel fall off... } + CalcLight := p.Z / p.MagnitudeSq; + Exit; + End; + f := -(mPosn.Z)/(p2.Z - mPosn.Z); + x := 160 + Trunc(SC*((p2.X-mPosn.X)*f+mPosn.X)); +{$IFNDEF INV} + If (x < 0) Or (x > 319) Then + Begin + CalcLight := p.Z / p.MagnitudeSq; + Exit; + End; + y := 100 + Trunc(SC*((p2.Y-mPosn.Y)*f+mPosn.Y)); + If (y < 0) Or (y > 199) Then + Begin + CalcLight := p.Z / p.MagnitudeSq; + Exit; + End; + c := MaskMap[y * 320 + x]; +{$ELSE} + If (x < 0) Or (x > 319) Then + Begin + CalcLight := 0; + Exit; + End; + y := 100 + Trunc(SC*((p2.Y-mPosn.Y)*f+mPosn.Y)); + If (y < 0) Or (y > 199) Then + Begin + CalcLight := 0; + Exit; + End; + c := 255 - MaskMap[y * 320 + x]; +{$ENDIF} + If c = 0 Then + Begin + CalcLight := 0; + Exit; + End; + CalcLight := (c*(1/255))*p.Z / p.MagnitudeSq; +End; + +Function CLIPC(f : Single) : Integer; {Inline;} + +Var + a : Integer; + +Begin + a := Trunc(f * 255); + If a < 0 Then + a := 0 + Else + If a > 255 Then + a := 255; + CLIPC := a; +End; + +Procedure initfrand; + +Var + s, c1 : Integer; + +Begin + FillChar(frandtab, SizeOf(frandtab), 0); + s := 1; + For c1 := 1 To 65535 Do + Begin + frandtab[c1] := s And $FFFF; + s := (((s Shr 4) Xor (s Shr 13) Xor (s Shr 15)) And 1) + (s Shl 1); + End; +End; + +Function frand : Integer; {Inline;} + +Begin + frand := frandtab[frandtab_seed]; + frandtab_seed := (frandtab_seed + 1) And $FFFF; +End; + +Procedure VLightPart(console : TPTCConsole; surface : TPTCSurface); + +Var + vl, vl2 : VLight; + camposn : FVector; + camaxis : FMatrix; + c1, c2, c3, ti, xx, yy, zz, i, a, x, y : Integer; + idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of Uint8; + order : Array[0..10*19 - 1, 0..1] Of Integer; + vlightt, t, cz, camf : Single; + col : FVector; + ray : TRay; + oc, c, c2_ : Uint32; + time, delta : Single; + pitch : Integer; + screenbuf, pd : PUint8; + tmp : FVector; + F : File; + +Begin + oc := 0; + initfrand; + tmp.Init(0.1, 0.4, 1); + vl := VLight.Create(tmp); + tmp.Init(1, 0.5, 0.2); + vl2 := VLight.Create(tmp); + tmp.Init(0, 0, 20); + vl.Move(tmp); + tmp.Init(0, 6, 30); + vl2.Move(tmp); + + camposn.Init(7, 0.5, -10); + camaxis.Init; + camaxis.MakeID; + tmp.Init(0, 0, 0); + camaxis.Row[2] := tmp - camposn; + camaxis.Normalise; + camf := 100; + + MaskMap := GetMem(320 * 200); + FillChar(MaskMap^, 320 * 200, 0); + + { load mojo.raw } + ASSign(F, 'mojo.raw'); + Reset(F, 1); + BlockRead(F, MaskMap^, 320*200); + Close(F); + + { build the order of the squares } + For c1 := 0 To 10*19 - 1 Do + Begin + order[c1, 0] := c1 Mod 19; + order[c1, 1] := (c1 Div 19) + 1; + End; + + { swap them around } + For c1 := 0 To 9999 Do + Begin + c2 := Random(190); + c3 := Random(190); + ti := order[c2, 0]; order[c2, 0] := order[c3, 0]; order[c3, 0] := ti; + ti := order[c2, 1]; order[c2, 1] := order[c3, 1]; order[c3, 1] := ti; + End; + + { time settings } + time := 0; + delta := 0.01; { this controls the speed of the effect } + + { main loop } + While Not console.KeyPressed Do + Begin + { get surface data } + pitch := surface.pitch; + + { light time (makes the effect loop) } + vlightt := 320 * Abs(Sin(time/5)); + + t := 13 - 0.1822 * vlightt; + cz := 1 - 0.01 * vlightt; + {tmp.Init(Sin(t)*5, Cos(t*-0.675+4543)*5, 15); + vl.Move(tmp); + tmp.Init(0, 0, -15); + vl.Move(tmp);} + tmp.Init(t, 0, 22); + vl.Move(tmp); + tmp.Init(-t, -7, 28); + vl2.Move(tmp); + + camposn.Init(cz*4+9, cz, -t/7-13); + tmp.Init(0, 0, 0); + camaxis.Row[2] := tmp - camposn; + camaxis.Normalise; + + FillChar(idx, SizeOf(idx), 25); + + { swap them around } + For c1 := 0 To 99 Do + Begin + c2 := Random(190); + c3 := Random(190); + ti := order[c2, 0]; order[c2, 0] := order[c3, 0]; order[c3, 0] := ti; + ti := order[c2, 1]; order[c2, 1] := order[c3, 1]; order[c3, 1] := ti; + End; + For zz := 0 To 189 Do + Begin + xx := order[zz, 0]; + yy := order[zz, 1]; + i := 0; + + { lock surface } + screenbuf := surface.lock; + Try + c2 := idx[yy, xx] Shr 1; + For c1 := 0 To c2 - 1 Do + Begin + a := frand And 255; + x := xx * 16 + (a And 15) + 6 + 4; + y := yy * 16 + (a Shr 4) + 6; + + col.Init(0, 0, 0); + ray.Init(camposn, camaxis.Row[2]*camf+camaxis.Row[0]*(x-160)+camaxis.Row[1]*(y-100)); + col += vl.Light(ray); + col += vl2.Light(ray); + + c := (CLIPC(col.X) Shl 16) + (CLIPC(col.Y) Shl 8) + (CLIPC(col.Z)); + pd := screenbuf + x*4 + y*pitch; + Inc(i, Abs(Integer(c And 255)-Integer(pd[321] And 255)) + Abs(Integer(c Shr 16)-Integer(pd[321] Shr 16))); + If c1 <> 0 Then + Inc(i, Abs(Integer(c And 255)-Integer(oc And 255)) + Abs(Integer(c Shr 16)-Integer(oc Shr 16))); + oc := c; + + c2_ := (c Shr 1) And $7F7F7F; + PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_; + PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_; + Inc(pd, pitch); + PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_; + PUint32(pd)[1] := c; + PUint32(pd)[2] := c; + PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_; + Inc(pd, pitch); + PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_; + PUint32(pd)[1] := c; + PUint32(pd)[2] := c; + PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_; + Inc(pd, pitch); + PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_; + PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_; + End; + i *= 5; + i := i Div (3*idx[yy, xx]); + If i < 2 Then + i := 2; + If i > {256}255 Then + i := {256}255; + idx[yy, xx] := i; + Finally + { unlock surface } + surface.unlock; + End; + + If (zz Mod 95) = 0 Then + Begin + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + End; + End; + { update time } + time += delta; + End; + FreeMem(MaskMap); + vl.Free; + vl2.Free; +End; + +Var + format : TPTCFormat; + console : TPTCConsole; + surface : TPTCSurface; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { create console } + console := TPTCConsole.Create; + + { open console } + console.open('mojo by statix', 320, 200, format); + + { create main drawing surface } + surface := TPTCSurface.Create(320, 200, format); + + { do the light effect } + VLightPart(console, surface); + + Finally + { close console } + console.close; + console.Free; + surface.Free; + format.Free; + End; + + { print message to stdout } + Writeln('mojo by alex "statix" evans'); + Writeln('to be used as an example of bad coding and good ptc'); + Writeln('no responsibility taken for this!'); + Writeln('enjoy ptc! it''s great'); + Writeln; + Writeln('-statix 13/1/98'); + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/mojo.raw b/packages/ptc/examples/mojo.raw Binary files differnew file mode 100644 index 0000000000..3ef71a7858 --- /dev/null +++ b/packages/ptc/examples/mojo.raw diff --git a/packages/ptc/examples/palette.pp b/packages/ptc/examples/palette.pp new file mode 100644 index 0000000000..c9e53561b7 --- /dev/null +++ b/packages/ptc/examples/palette.pp @@ -0,0 +1,102 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Palette example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program PaletteExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + palette : TPTCPalette; + data : Array[0..255] Of int32; + pixels : Pchar8; + width, height : Integer; + i : Integer; + x, y, index : Integer; + +Begin + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(8); + + { open console } + console.open('Palette example', format); + + { create surface } + surface := TPTCSurface.Create(console.width, console.height, format); + format.Free; + + { create palette } + palette := TPTCPalette.Create; + + { generate palette } + For i := 0 To 255 Do + data[i] := i; + + { load palette data } + palette.load(data); + + { set console palette } + console.palette(palette); + + { set surface palette } + surface.palette(palette); + palette.Free; + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + pixels := surface.lock; + + { get surface dimensions } + width := surface.width; + height := surface.height; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color index } + index := Random(256); + + { draw color [index] at position [x,y] } + pixels[x + y * width] := index; + End; + + { unlock surface } + surface.unlock; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + End; + console.close; + console.Free; + surface.Free; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/pixel.pp b/packages/ptc/examples/pixel.pp new file mode 100644 index 0000000000..701612c5b2 --- /dev/null +++ b/packages/ptc/examples/pixel.pp @@ -0,0 +1,84 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Pixel example for OpenPTC 1.0 C++ API + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is licensed under the GNU GPL +} + +Program PixelExample; + +{$MODE objfpc} + +Uses + ptc; + +Procedure putpixel(surface : TPTCSurface; x, y : Integer; r, g, b : char8); + +Var + pixels : Pint32; + color : int32; + +Begin + { lock surface } + pixels := surface.lock; + Try + { pack the color integer from r,g,b components } + color := (r Shl 16) Or (g Shl 8) Or b; + + { plot the pixel on the surface } + pixels[x + y * surface.width] := color; + Finally + { unlock surface } + surface.unlock; + End; +End; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Pixel example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { plot a white pixel in the middle of the surface } + putpixel(surface, surface.width Div 2, surface.height Div 2, 255, 255, 255); + + { copy to console } + surface.copy(console); + + { update console } + console.update; + + { read key } + console.ReadKey; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/random.pp b/packages/ptc/examples/random.pp new file mode 100644 index 0000000000..e898f0192b --- /dev/null +++ b/packages/ptc/examples/random.pp @@ -0,0 +1,92 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Random example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program RandomExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + pixels : Pint32; + width, height : Integer; + i : Integer; + x, y, r, g, b : Integer; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Random example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { draw random pixels } + For i := 1 To 100 Do + Begin + { get random position } + x := Random(width); + y := Random(height); + + { get random color } + r := Random(256); + g := Random(256); + b := Random(256); + + { draw color [r,g,b] at position [x,y] } + pixels[x + y * width] := (r Shl 16) + (g Shl 8) + b; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + End; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/save.pp b/packages/ptc/examples/save.pp new file mode 100644 index 0000000000..a579295e5d --- /dev/null +++ b/packages/ptc/examples/save.pp @@ -0,0 +1,290 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Save example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program SaveExample; + +{$MODE objfpc} + +Uses + ptc, Math; + +Procedure save(surface : TPTCSurface; filename : String); + +Const + { generate the header for a true color targa image } + header : Array[0..17] Of char8 = + (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); + +Var + F : File; + width, height : Integer; + size : Integer; + y : Integer; + pixels : Pchar8; + format : TPTCFormat; + palette : TPTCPalette; + +Begin + { open image file for writing } + ASSign(F, filename); + Rewrite(F, 1); + + { get surface dimensions } + width := surface.width; + height := surface.height; + + { set targa image width } + header[12] := width And $FF; + header[13] := width Shr 8; + + { set targa image height } + header[14] := height And $FF; + header[15] := height Shr 8; + + { set bits per pixel } + header[16] := 24; + + { write tga header } + BlockWrite(F, header, 18); + + { calculate size of image pixels } + size := width * height * 3; + + { allocate image pixels } + pixels := GetMem(size); + + format := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + palette := TPTCPalette.Create; + + { save surface to image pixels } + surface.save(pixels, width, height, width * 3, format, palette); + + palette.Free; + format.Free; + + { write image pixels one line at a time } + For y := height - 1 DownTo 0 Do + BlockWrite(F, pixels[width * y * 3], width * 3); + + { free image pixels } + FreeMem(pixels); + + Close(F); +End; + +Function calculate(real, imaginary : Single; maximum : Integer) : Integer; + +Var + c_r, c_i : Single; + z_r, z_i : Single; + z_r_squared, z_i_squared : Single; + z_squared_magnitude : Single; + count : Integer; + +Begin + { complex number 'c' } + c_r := real; + c_i := imaginary; + + { complex 'z' } + z_r := 0; + z_i := 0; + + { complex 'z' squares } + z_r_squared := 0; + z_i_squared := 0; + + { mandelbrot function iteration loop } + For count := 0 To maximum - 1 Do + Begin + { square 'z' and add 'c' } + z_i := 2 * z_r * z_i + c_i; + z_r := z_r_squared - z_i_squared + c_r; + + { update 'z' squares } + z_r_squared := z_r * z_r; + z_i_squared := z_i * z_i; + + { calculate squared magnitude of complex 'z' } + z_squared_magnitude := z_r_squared + z_i_squared; + + { stop iterating if the magnitude of 'z' is greater than two } + If z_squared_magnitude > 4 Then + Begin + calculate := Count; + Exit; + End; + End; + + { maximum } + calculate := 0; +End; + +Procedure mandelbrot(console : TPTCConsole; surface : TPTCSurface; + x1, y1, x2, y2 : Single); + +Const + { constant values } + entries = 1024; + maximum = 1024; + +Var + { fractal color table } + table : Array[0..entries - 1] Of int32; + i : Integer; + f_index : Single; + time : Single; + intensity : Single; + pixels, pixel : Pint32; + width, height : Integer; + dx, dy : Single; + real, imaginary : Single; + x, y : Integer; + count : Integer; + index : Integer; + color : int32; + area : TPTCArea; + +Begin + { generate fractal color table } + For i := 0 To entries - 1 Do + Begin + { calculate normalized index } + f_index := i / entries; + + { calculate sine curve time value } + time := f_index * pi - pi / 2; + + { lookup sine curve intensity at time and scale to [0,1] } + intensity := (sin(time) + 1) / 2; + + { raise the intensity to a power } + intensity := power(intensity, 0.1); + + { store intensity as a shade of blue } + table[i] := Trunc(255 * intensity); + End; + + { lock surface pixels } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { current pixel pointer } + pixel := pixels; + + { calculate real x,y deltas } + dx := (x2 - x1) / width; + dy := (y2 - y1) / height; + + { imaginary axis } + imaginary := y1; + + { iterate down surface y } + For y := 0 To height - 1 Do + Begin + { real axis } + real := x1; + + { iterate across surface x } + For x := 0 To width - 1 Do + Begin + { calculate the mandelbrot interation count } + count := calculate(real, imaginary, maximum); + + { calculate color table index } + index := count Mod entries; + + { lookup color from iteration } + color := table[index]; + + { store color } + pixel^ := color; + + { next pixel } + Inc(pixel); + + { update real } + real := real + dx; + End; + + { update imaginary } + imaginary := imaginary + dy; + + { setup line area } + area := TPTCArea.Create(0, y, width, y + 1); + Try + { copy surface area to console } + surface.copy(console, area, area); + Finally + area.Free; + End; + + { update console area } + console.update; + End; + Finally + { unlock surface } + surface.unlock; + End; +End; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + x1, y1, x2, y2 : Single; + +Begin + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console with a single page } + console.open('Save example', format, 1); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { setup viewing area } + x1 := -2.00; + y1 := -1.25; + x2 := +1.00; + y2 := +1.25; + + { render the mandelbrot fractal } + mandelbrot(console, surface, x1, y1, x2, y2); + + { save mandelbrot image } + save(surface, 'save.tga'); + + { read key } + console.ReadKey; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/stretch.pp b/packages/ptc/examples/stretch.pp new file mode 100644 index 0000000000..f7cf768b0d --- /dev/null +++ b/packages/ptc/examples/stretch.pp @@ -0,0 +1,164 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Stretch example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program StretchExample; + +{$MODE objfpc} + +Uses + ptc; + +Procedure load(surface : TPTCSurface; filename : String); + +Var + F : File; + width, height : Integer; + pixels : PByte; + y : Integer; + tmp : TPTCFormat; + tmp2 : TPTCPalette; + +Begin + { open image file } + ASSign(F, filename); + Reset(F, 1); + + { skip header } + Seek(F, 18); + + { get surface dimensions } + width := surface.width; + height := surface.height; + + { allocate image pixels } + pixels := GetMem(width * height * 3); + Try + { read image pixels one line at a time } + For y := height - 1 DownTo 0 Do + BlockRead(F, pixels[width * y * 3], width * 3); + + { load pixels to surface } + tmp := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + Try + tmp2 := TPTCPalette.Create; + Try + surface.load(pixels, width, height, width * 3, tmp, tmp2); + Finally + tmp2.Free; + End; + Finally + tmp.Free; + End; + Finally + { free image pixels } + FreeMem(pixels); + End; +End; + +Var + console : TPTCConsole; + surface : TPTCSurface; + image : TPTCSurface; + format : TPTCFormat; + timer : TPTCTimer; + area : TPTCArea; + color : TPTCColor; + time : Double; + zoom : Single; + x, y, x1, y1, x2, y2, dx, dy : Integer; + +Begin + format := Nil; + color := Nil; + timer := Nil; + image := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Stretch example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { create image surface } + image := TPTCSurface.Create(320, 140, format); + + { load image to surface } + load(image, 'stretch.tga'); + + { setup stretching parameters } + x := surface.width Div 2; + y := surface.height Div 2; + dx := surface.width Div 2; + dy := surface.height Div 3; + + { create timer } + timer := TPTCTimer.Create; + + { start timer } + timer.start; + color := TPTCColor.Create(1, 1, 1); + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { get current time from timer } + time := timer.time; + + { clear surface to white background } + surface.clear(color); + + { calculate zoom factor at current time } + zoom := 2.5 * (1 - cos(time)); + + { calculate zoomed image coordinates } + x1 := Trunc(x - zoom * dx); + y1 := Trunc(y - zoom * dy); + x2 := Trunc(x + zoom * dx); + y2 := Trunc(y + zoom * dy); + + { setup image copy area } + area := TPTCArea.Create(x1, y1, x2, y2); + Try + { copy and stretch image to surface } + image.copy(surface, image.area, area); + + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + Finally + area.Free; + End; + End; + Finally + console.close; + console.Free; + surface.Free; + format.Free; + image.Free; + color.Free; + timer.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/stretch.tga b/packages/ptc/examples/stretch.tga Binary files differnew file mode 100644 index 0000000000..f0441d2bd8 --- /dev/null +++ b/packages/ptc/examples/stretch.tga diff --git a/packages/ptc/examples/texwarp.pp b/packages/ptc/examples/texwarp.pp new file mode 100644 index 0000000000..81cbb0806c --- /dev/null +++ b/packages/ptc/examples/texwarp.pp @@ -0,0 +1,396 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Texture warp demo for OpenPTC 1.0 C++ API + Copyright (c) 1998 Jonathan Matthew + This source code is licensed under the GNU GPL +} + +Program TexWarp; + +{$MODE objfpc} + +Uses + ptc; + +Const +{ colour balance values. change these if you don't like the colouring } +{ of the texture. } + red_balance : Uint32 = 2; + green_balance : Uint32 = 3; + blue_balance : Uint32 = 1; + +Procedure blur(s : TPTCSurface); + +Var + d : PUint8; + pitch : Integer; + spack, r : Integer; + +Begin + { lock surface } + d := s.lock; + + Try + pitch := s.pitch; + spack := (s.height - 1) * pitch; + + { first pixel } + For r := 0 To 3 Do + d[r] := (d[pitch + r] + d[r + 4] + d[spack + r] + d[pitch - 4 + r]) Div 4; + + { rest of first line } + For r := 4 To pitch - 1 Do + d[r] := (d[r + pitch] + d[r + 4] + d[r - 4] + d[spack + r]) Div 4; + + { rest of surface except last line } + For r := pitch To ((s.height - 1) * pitch) - 1 Do + d[r] := (d[r - pitch] + d[r + pitch] + d[r + 4] + d[r - 4]) Div 4; + + { last line except last pixel } + For r := (s.height - 1) * pitch To (s.height * s.pitch) - 5 Do + d[r] := (d[r - pitch] + d[r + 4] + d[r - 4] + d[r - spack]) Div 4; + + { last pixel } + For r := (s.height * s.pitch) - 4 To s.height * s.pitch Do + d[r] := (d[r - pitch] + d[r - 4] + d[r - spack] + d[r + 4 - pitch]) Div 4; + + Finally + s.unlock; + End; +End; + +Procedure generate(surface : TPTCSurface); + +Var + dest : PUint32; + i : Integer; + x, y : Integer; + d : PUint32; + cv : Uint32; + r, g, b : Uint8; + +Begin + { draw random dots all over the surface } + dest := surface.lock; + Try + For i := 0 To surface.width * surface.height - 1 Do + Begin + x := Random(surface.width); + y := Random(surface.height); + d := dest + (y * surface.width) + x; + cv := (Random(100) Shl 16) Or (Random(100) Shl 8) Or Random(100); + d^ := cv; + End; + Finally + surface.unlock; + End; + + { blur the surface } + For i := 1 To 5 Do + blur(surface); + + { multiply the color values } + dest := surface.lock; + Try + For i := 0 To surface.width * surface.height - 1 Do + Begin + cv := dest^; + r := (cv Shr 16) And 255; + g := (cv Shr 8) And 255; + b := cv And 255; + r *= red_balance; + g *= green_balance; + b *= blue_balance; + If r > 255 Then + r := 255; + If g > 255 Then + g := 255; + If b > 255 Then + b := 255; + dest^ := (r Shl 16) Or (g Shl 8) Or b; + Inc(dest); + End; + Finally + surface.unlock; + End; +End; + +Procedure grid_map(grid : PUint32; xbase, ybase, xmove, ymove, amp : Single); + +Var + x, y : Integer; + a, b, id : Single; + +Begin + a := 0; + For y := 0 To 25 Do + Begin + b := 0; + For x := 0 To 40 Do + Begin + { it should be noted that there is no scientific basis for } + { the following three lines :) } + grid[0] := Uint32(Trunc((xbase * 14 + x*4 + xmove*sin(b)+sin(cos(a)*sin(amp))*15) * 65536)); + grid[1] := Uint32(Trunc((ybase * 31 + y*3 + ymove*cos(b)*sin(sin(a)*cos(amp))*30) * 65536)); + id := (cos(xbase) + sin(ybase) + cos(a*xmove*0.17) + sin(b*ymove*0.11)) * amp * 23; + If id < -127 Then + grid[2] := 0 + Else + If id > 127 Then + grid[2] := 255 Shl 16 + Else + grid[2] := (128 Shl 16) + Trunc(id * 65536.0); + grid += 3; + b += pi / 30; + End; + a += pi / 34; + End; +End; + +Procedure make_light_table(lighttable : PUint8); + +Var + i, j : Integer; + tv : Integer; + +Begin + For i := 0 To 255 Do + For j := 0 To 255 Do + Begin + { light table goes from 0 to i*2. } + tv := (i * j) Div 128; + If tv > 255 Then + tv := 255; + lighttable[(j * 256) + i] := tv; + End; +End; + +{ if you want to see how to do this properly, look at the tunnel3d demo. } +{ (not included in this distribution :) } +Procedure texture_warp(dest, grid, texture : PUint32; lighttable : PUint8); + +Var + utl, utr, ubl, ubr : Integer; + vtl, vtr, vbl, vbr : Integer; + itl, itr, ibl, ibr : Integer; + dudx, dvdx, didx, dudy, dvdy, didy, ddudy, ddvdy, ddidy : Integer; + dudx2, dvdx2, didx2 : Integer; + bx, by, px, py : Integer; + uc, vc, ic, ucx, vcx, icx : Integer; + + edi : Uint32; + texel : Uint32; + + cbp, dp : PUint32; + dpix : Uint32; + + ltp : PUint8; + +Begin + cbp := grid; + For by := 0 To 24 Do + Begin + For bx := 0 To 39 Do + Begin + utl := Integer(cbp^); + vtl := Integer((cbp + 1)^); + itl := Integer((cbp + 2)^); + utr := Integer((cbp + (1 * 3))^); + vtr := Integer((cbp + (1 * 3) + 1)^); + itr := Integer((cbp + (1 * 3) + 2)^); + ubl := Integer((cbp + (41 * 3))^); + vbl := Integer((cbp + (41 * 3) + 1)^); + ibl := Integer((cbp + (41 * 3) + 2)^); + ubr := Integer((cbp + (42 * 3))^); + vbr := Integer((cbp + (42 * 3) + 1)^); + ibr := Integer((cbp + (42 * 3) + 2)^); + dudx := (utr - utl) Div 8; + dvdx := (vtr - vtl) Div 8; + didx := (itr - itl) Div 8; + dudx2 := (ubr - ubl) Div 8; + dvdx2 := (vbr - vbl) Div 8; + didx2 := (ibr - ibl) Div 8; + dudy := (ubl - utl) Div 8; + dvdy := (vbl - vtl) Div 8; + didy := (ibl - itl) Div 8; + ddudy := (dudx2 - dudx) Div 8; + ddvdy := (dvdx2 - dvdx) Div 8; + ddidy := (didx2 - didx) Div 8; + uc := utl; + vc := vtl; + ic := itl; + For py := 0 To 7 Do + Begin + ucx := uc; + vcx := vc; + icx := ic; + dp := dest + (((by * 8 + py)*320) + (bx * 8)); + For px := 0 To 7 Do + Begin + + { get light table pointer for current intensity } + ltp := lighttable + ((icx And $FF0000) Shr 8); + + { get texel } + edi := ((ucx And $FF0000) Shr 16) + ((vcx And $FF0000) Shr 8); + texel := texture[edi]; + + { calculate actual colour } + dpix := ltp[(texel Shr 16) And 255]; + dpix := dpix Shl 8; + dpix := dpix Or ltp[(texel Shr 8) And 255]; + dpix := dpix Shl 8; + dpix := dpix Or ltp[texel And 255]; + + dp^ := dpix; + Inc(dp); + + ucx += dudx; + vcx += dvdx; + icx += didx; + End; + uc += dudy; + vc += dvdy; + ic += didy; + dudx += ddudy; + dvdx += ddvdy; + didx += ddidy; + End; + cbp += 3; + End; + cbp += 3; + End; +End; + +Var + format : TPTCFormat; + texture : TPTCSurface; + surface : TPTCSurface; + console : TPTCConsole; + lighttable : PUint8; + { texture grid } + grid : Array[0..41*26*3-1] Of Uint32; + xbase, ybase, xmove, ymove, amp, dct, dxb, dyb, dxm, dym, sa : Single; + + p1, p2 : PUint32; + +Begin + format := Nil; + texture := Nil; + surface := Nil; + console := Nil; + lighttable := Nil; + Try + Try + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { create texture surface } + texture := TPTCSurface.Create(256, 256, format); + + { create texture } + generate(texture); + + { create lighttable } + lighttable := GetMem(256 * 256); + make_light_table(lighttable); + + { create console } + console := TPTCConsole.Create; + + { open console } + console.open('Warp demo', 320, 200, format); + + { create drawing surface } + surface := TPTCSurface.Create(320, 200, format); + + { control values } + xbase := 0; + ybase := 0; + xmove := 0; + ymove := 0; + amp := 0; + dct := 0.024; + dxb := 0.031; + dyb := -0.019; + dxm := 0.015; + dym := -0.0083; + + { main loop } + While Not console.KeyPressed Do + Begin + + { create texture mapping grid } + grid_map(grid, xbase, ybase, xmove, ymove*3, amp); + + p1 := surface.lock; + Try + p2 := texture.lock; + Try + { map texture to drawing surface } + texture_warp(p1, grid, p2, lighttable); + Finally + texture.unlock; + End; + Finally + surface.unlock; + End; + + { copy surface to console } + surface.copy(console); + + { update console } + console.update; + + { move control values (limit them so it doesn't go too far) } + xbase += dxb; + If xbase > pi Then + dxb := -dxb; + If xbase < (-pi) Then + dxb := -dxb; + + ybase += dyb; + If ybase > pi Then + dyb := -dyb; + If ybase < (-pi) Then + dyb := -dyb; + + xmove += dxm; + If xmove > pi Then + dxm := -dxm; + If xmove < (-pi) Then + dxm := -dxm; + + ymove += dym; + If ymove > pi Then + dym := -dym; + If ymove < (-pi) Then + dym := -dym; + + amp += dct; + sa := sin(amp); + If (sa > -0.0001) And (sa < 0.0001) Then + Begin + If amp > 8.457547 Then + dct := -dct; + If amp < -5.365735 Then + dct := -dct; + End; + End; + Finally + console.close; + console.Free; + surface.Free; + texture.Free; + format.Free; + If assigned(lighttable) Then + FreeMem(lighttable); + End; + Except + On e : TPTCError Do + e.report; + End; +End. diff --git a/packages/ptc/examples/timer.pp b/packages/ptc/examples/timer.pp new file mode 100644 index 0000000000..1cef973ad7 --- /dev/null +++ b/packages/ptc/examples/timer.pp @@ -0,0 +1,116 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Timer example for OpenPTC 1.0 C++ Implementation + Copyright (c) Glenn Fiedler (ptc@gaffer.org) + This source code is in the public domain +} + +Program TimerExample; + +{$MODE objfpc} + +Uses + ptc; + +Var + console : TPTCConsole; + format : TPTCFormat; + surface : TPTCSurface; + timer : TPTCTimer; + time, t : Double; + pixels : PDWord; + width, height : Integer; + repeats, center, magnitude, intensity, sx : Single; + x, y : Integer; + +Begin + timer := Nil; + format := Nil; + surface := Nil; + console := Nil; + Try + Try + { create console } + console := TPTCConsole.Create; + + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { open the console } + console.open('Timer example', format); + + { create surface matching console dimensions } + surface := TPTCSurface.Create(console.width, console.height, format); + + { create timer } + timer := TPTCTimer.Create; + + { start timer } + timer.start; + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { get current time from timer } + time := timer.time; + + { clear surface } + surface.clear; + + { lock surface } + pixels := surface.lock; + Try + { get surface dimensions } + width := surface.width; + height := surface.height; + + { sine curve parameters } + repeats := 2; + center := height / 2; + magnitude := height / 3; + + { render a sine curve } + For x := 0 To width - 1 Do + Begin + { rescale 'x' in the range [0,2*pi] } + sx := x / width * 2 * pi; + + { calculate time at current position } + t := time + sx * repeats; + + { lookup sine intensity at time 't' } + intensity := sin(t); + + { convert intensity to a y position on the surface } + y := Trunc(center + intensity * magnitude); + + { plot pixel on sine curve } + pixels[x + y * width] := $000000FF; + End; + Finally + { unlock surface } + surface.unlock; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + End; + Finally + timer.Free; + surface.Free; + console.close; + console.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/tunnel.pp b/packages/ptc/examples/tunnel.pp new file mode 100644 index 0000000000..15b1815404 --- /dev/null +++ b/packages/ptc/examples/tunnel.pp @@ -0,0 +1,198 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Tunnel demo for OpenPTC 1.0 C++ API + Originally coded by Thomas Rizos (rizos@swipnet.se) + Adapted for OpenPTC by Glenn Fiedler (ptc@gaffer.org) + This source code is licensed under the GNU GPL +} + +Program Tunnel; + +{$MODE objfpc} + +Uses + ptc, Math; + +Type + { tunnel class } + TTunnel = Class(TObject) + Public + Constructor Create; + Destructor Destroy; Override; + Procedure setup; + Procedure draw(buffer : PUint32; t : Single); + Private + { tunnel data } + tunnel : PUint32; + texture : PUint8; + End; + +Constructor TTunnel.Create; + +Begin + tunnel := Nil; + texture := Nil; + + { allocate tables } + tunnel := GetMem(320*200*SizeOf(Uint32)); + texture := GetMem(256*256*2*SizeOf(Uint8)); + + { setup } + setup; +End; + +Destructor TTunnel.Destroy; + +Begin + { free tables } + If assigned(tunnel) Then + FreeMem(tunnel); + If assigned(texture) Then + FreeMem(texture); + + Inherited Destroy; +End; + +Procedure TTunnel.setup; + +Var + index : Integer; + x, y : Integer; + angle, angle1, angle2, radius, u, v : Double; + +Begin + { tunnel index } + index := 0; + + { generate tunnel table } + For y := 100 DownTo -99 Do + For x := -160 To 159 Do + Begin + { calculate angle from center } + angle := arctan2(y, x) * 256 / pi / 2; + + { calculate radius from center } + radius := sqrt(x * x + y * y); + + { clamp radius to minimum } + If radius < 1 Then + radius := 1; + + { texture coordinates } + u := angle; + v := 6000 / radius; + + { calculate texture index for (u,v) } + tunnel[index] := (Trunc(v) And $FF) * 256 + (Trunc(u) And $FF); + Inc(index); + End; + + { generate blue plasma texture } + index := 0; + angle2 := pi * 2/256 * 230; + For y := 0 To 256 * 2 - 1 Do + Begin + angle1 := pi * 2/256 * 100; + For x := 0 To 256-1 Do + Begin + texture[index] := Trunc(sin(angle1)*80 + sin(angle2)*40 + 128); + angle1 := angle1 + pi*2/256*3; + Inc(index); + End; + angle2 := angle2 + pi * 2/256 *2; + End; +End; + +Procedure TTunnel.draw(buffer : PUint32; t : Single); + +Var + x, y : Integer; + scroll : Uint32; + i : Integer; + +Begin + { tunnel control functions } + x := Trunc(sin(t) * 99.9); + y := Trunc(t * 200); + + { calculate tunnel scroll offset } + scroll := ((y And $FF) Shl 8) + (x And $FF); + + { loop through each pixel } + For i := 0 To 64000-1 Do + { lookup tunnel texture } + buffer[i] := texture[tunnel[i] + scroll]; +End; + +Var + format : TPTCFormat; + console : TPTCConsole; + surface : TPTCSurface; + TheTunnel : TTunnel; + time, delta : Single; + buffer : PUint32; + +Begin + format := Nil; + surface := Nil; + console := Nil; + TheTunnel := Nil; + Try + Try + { create format } + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + { create console } + console := TPTCConsole.Create; + + { open console } + console.open('Tunnel demo', 320, 200, format); + + { create surface } + surface := TPTCSurface.Create(320, 200, format); + + { create tunnel } + TheTunnel := TTunnel.Create; + + { time data } + time := 0; + delta := 0.03; + + { loop until a key is pressed } + While Not console.KeyPressed Do + Begin + { lock surface } + buffer := surface.lock; + Try + { draw tunnel } + TheTunnel.draw(buffer, time); + Finally + { unlock surface } + surface.unlock; + End; + + { copy to console } + surface.copy(console); + + { update console } + console.update; + + { update time } + time += delta; + End; + Finally + TheTunnel.Free; + surface.Free; + console.close; + console.Free; + format.Free; + End; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. diff --git a/packages/ptc/examples/tunnel3d.pp b/packages/ptc/examples/tunnel3d.pp new file mode 100644 index 0000000000..ccf3c7a6af --- /dev/null +++ b/packages/ptc/examples/tunnel3d.pp @@ -0,0 +1,612 @@ +{ +Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) +} + +{ + Tunnel3D demo for OpenPTC 1.0 C++ API + + Realtime raytraced tunnel + Copyright (c) 1998 Christian Nentwich (brn@eleet.mcb.at) + This source code is licensed under the GNU LGPL + + And do not just blatantly cut&paste this into your demo :) +} + +Program Tunnel3D; + +{$MODE objfpc} + +Uses + ptc, Math; + +Type + PVector = ^TVector; + TVector = Array[0..2] Of Single; { X,Y,Z } + TMatrix = Array[0..3, 0..3] Of Single;{ FIRST = COLUMN + SECOND = ROW + + [0, 0] [1, 0] [2, 0] + [0, 1] [1, 1] [2, 1] + [0, 2] [1, 2] [2, 2] + (I know the matrices are the wrong way round, so what, the code is quite + old :) } + + TRayTunnel = Class(TObject) + Private + tunneltex : PUint8; { Texture } + pal : PUint8; { Original palette } + lookup : PUint32; { Lookup table for lighting } + + sintab, costab : PSingle; { Take a guess } + + u_array, v_array, l_array : PInteger; { Raytraced coordinates and light } + norms : PVector; + + radius, radius_sqr : Single; + rot : TMatrix; + + pos, light : TVector; { Position in the tunnel, pos of } + xa, ya, za : Integer; { lightsource, angles } + + lightstatus : Boolean; { Following the viewer ? } + + Public + Constructor Create(rad : Single); { Constructor takes the radius } + Destructor Destroy; Override; + + Procedure load_texture; + + Procedure tilt(x, y, z : Integer); { Rotate relative } + Procedure tilt(x, y, z : Integer; abs : Uint8); { Absolute } + + Procedure move(dx, dy, dz : Single); { Relative move } + Procedure move(x, y, z : Single; abs : Uint8); { Absolute } + + Procedure movelight(dx, dy, dz : Single); + Procedure movelight(x, y, z : Single; abs : Uint8); + + Procedure locklight(lock : Boolean); { Make the light follow the viewer } + + Procedure interpolate; { Raytracing } + + Procedure draw(dest : PUint32); { Draw the finished tunnel } + End; + +{ VECTOR ROUTINES } +Procedure vector_normalize(Var v : TVector); + +Var + length : Single; + +Begin + length := v[0] * v[0] + v[1] * v[1] + v[2] * v[2]; + length := sqrt(length); + If length <> 0 Then + Begin + v[0] := v[0] / length; + v[1] := v[1] / length; + v[2] := v[2] / length; + End + Else + Begin + v[0] := 0; + v[1] := 0; + v[2] := 0; + End; +End; + +Procedure vector_times_matrix(Const v : TVector; Const m : TMatrix; + Var res : TVector); + +Var + i, j : Integer; + +Begin + For j := 0 To 2 Do + Begin + res[j] := 0; + For i := 0 To 2 Do + res[j] := res[j] + (m[j, i] * v[i]); + End; +End; + +Procedure matrix_idle(Var m : TMatrix); + +Begin + FillChar(m, SizeOf(TMatrix), 0); + m[0, 0] := 1; + m[1, 1] := 1; + m[2, 2] := 1; + m[3, 3] := 1; +End; + +Procedure matrix_times_matrix(Const m1, m2 : TMatrix; Var res : TMatrix); + +Var + i, j, k : Integer; + +Begin + For j := 0 To 3 Do + For i := 0 To 3 Do + Begin + res[i, j] := 0; + For k := 0 To 3 Do + res[i, j] := res[i, j] + (m1[k, j] * m2[i, k]); + End; +End; + +Procedure matrix_rotate_x(Var m : TMatrix; angle : Integer; sintab, costab : PSingle); + +Var + tmp, tmp2 : TMatrix; + +Begin + matrix_idle(tmp); + tmp[1, 1] := costab[angle]; + tmp[2, 1] := sintab[angle]; + tmp[1, 2] := -sintab[angle]; + tmp[2, 2] := costab[angle]; + matrix_times_matrix(tmp, m, tmp2); + Move(tmp2, m, SizeOf(TMatrix)); +End; + +Procedure matrix_rotate_y(Var m : TMatrix; angle : Integer; sintab, costab : PSingle); + +Var + tmp, tmp2 : TMatrix; + +Begin + matrix_idle(tmp); + tmp[0, 0] := costab[angle]; + tmp[2, 0] := -sintab[angle]; + tmp[0, 2] := sintab[angle]; + tmp[2, 2] := costab[angle]; + matrix_times_matrix(tmp, m, tmp2); + Move(tmp2, m, SizeOf(TMatrix)); +End; + +Procedure matrix_rotate_z(Var m : TMatrix; angle : Integer; sintab, costab : PSingle); + +Var + tmp, tmp2 : TMatrix; + +Begin + matrix_idle(tmp); + tmp[0, 0] := costab[angle]; + tmp[1, 0] := sintab[angle]; + tmp[0, 1] := -sintab[angle]; + tmp[1, 1] := costab[angle]; + matrix_times_matrix(tmp, m, tmp2); + Move(tmp2, m, SizeOf(TMatrix)); +End; + +Constructor TRayTunnel.Create(rad : Single); + +Var + x, y : Single; + i, j : Integer; + tmp : TVector; + +Begin + tunneltex := Nil; + sintab := Nil; + costab := Nil; + u_array := Nil; + v_array := Nil; + norms := Nil; + lookup := Nil; + pal := Nil; + + radius := rad; + radius_sqr := rad * rad; + + sintab := GetMem(1024 * SizeOf(Single)); { Set trigonometry and lookups } + costab := GetMem(1024 * SizeOf(Single)); + u_array := GetMem(64 * 26 * SizeOf(Integer)); + v_array := GetMem(64 * 26 * SizeOf(Integer)); + l_array := GetMem(64 * 26 * SizeOf(Integer)); + norms := GetMem(64 * 26 * 3 * SizeOf(Single)); + + lookup := GetMem(65 * 256 * SizeOf(Uint32)); + pal := GetMem(768 * SizeOf(Uint8)); + + For i := 0 To 1023 Do + Begin + sintab[i] := sin(i * pi / 512); + costab[i] := cos(i * pi / 512); + End; + + { Generate normal vectors } + y := -100; + For j := 0 To 25 Do + Begin + x := -160; + For i := 0 To 40 Do + Begin + tmp[0] := x; + tmp[1] := y; + tmp[2] := 128; + vector_normalize(tmp); + norms[j * 64 + i] := tmp; + x := x + 8; + End; + y := y + 8; + End; + + { Reset tunnel and light position and all angles } + pos[0] := 0; pos[1] := 0; pos[2] := 0; + light[0] := 1; light[1] := 1; light[2] := 0; + + xa := 0; ya := 0; za := 0; + + lightstatus := False; + + { Normalize light vector to length 1.0 } + vector_normalize(light); +End; + +Destructor TRayTunnel.Destroy; + +Begin + If Assigned(tunneltex) Then + FreeMem(tunneltex); + If Assigned(pal) Then + FreeMem(pal); + If Assigned(lookup) Then + FreeMem(lookup); + If Assigned(norms) Then + FreeMem(norms); + If Assigned(l_array) Then + FreeMem(l_array); + If Assigned(v_array) Then + FreeMem(v_array); + If Assigned(u_array) Then + FreeMem(u_array); + If Assigned(costab) Then + FreeMem(costab); + If Assigned(sintab) Then + FreeMem(sintab); +End; + +Procedure TRayTunnel.load_texture; + +Var + texfile : File; + tmp : PUint8; + i, j : Uint32; + r, g, b : Uint32; + newoffs : Integer; + +Begin + { Allocate tunnel texture 65536+33 bytes too big } + + If tunneltex <> Nil Then + Begin + FreeMem(tunneltex); + tunneltex := Nil; + End; + tunneltex := GetMem(2*65536 + 33); + tmp := GetMem(65536); + + { Align the texture on a 64k boundary } + While (PtrUInt(tunneltex) And $FFFF) <> 0 Do + Inc(tunneltex); + + ASSign(texfile, 'tunnel3d.raw'); + Reset(texfile, 1); + BlockRead(texfile, pal^, 768); + BlockRead(texfile, tmp^, 65536); + Close(texfile); + + { Generate lookup table for lighting (65 because of possible inaccuracies) } + + For j := 0 To 64 Do + For i := 0 To 255 Do + Begin + r := pal[i * 3] Shl 2; + g := pal[i * 3 + 1] Shl 2; + b := pal[i * 3 + 2] Shl 2; + r := (r * j) Shr 6; + g := (g * j) Shr 6; + b := (b * j) Shr 6; + If r > 255 Then + r := 255; + If g > 255 Then + g := 255; + If b > 255 Then + b := 255; + lookup[j * 256 + i] := (r Shl 16) Or (g Shl 8) Or b; + End; + + { Arrange texture for cache optimised mapping } + + For j := 0 To 255 Do + For i := 0 To 255 Do + Begin + newoffs := ((i Shl 8) And $F800) + (i And $0007) + ((j Shl 3) And $7F8); + (tunneltex + newoffs)^ := (tmp + j * 256 + i)^; + End; + + FreeMem(tmp); +End; + +Procedure TRayTunnel.interpolate; + +Var + ray, intsc, norm, lvec : TVector; + x, y, a, b, c, discr, t, res : Single; + i, j : Integer; + +Begin + If lightstatus Then { Lightsource locked to viewpoint } + light := pos; + + matrix_idle(rot); + matrix_rotate_x(rot, xa And $3FF, sintab, costab); + matrix_rotate_y(rot, ya And $3FF, sintab, costab); + matrix_rotate_z(rot, za And $3FF, sintab, costab); + + { Constant factor } + c := 2 * (pos[0] * pos[0] + pos[1] * pos[1] - radius_sqr); + + { Start raytracing } + y := -100; + For j := 0 To 25 Do + Begin + x := -160; + For i := 0 To 40 Do + Begin + vector_times_matrix(norms[(j Shl 6) + i], rot, ray); + + a := 2 * (ray[0] * ray[0] + ray[1] * ray[1]); + b := 2 * (pos[0] * ray[0] + pos[1] * ray[1]); + + discr := b * b - a * c; + If discr > 0 Then + Begin + discr := sqrt(discr); + t := (- b + discr) / a; + + { Calculate intersection point } + intsc[0] := pos[0] + t * ray[0]; + intsc[1] := pos[1] + t * ray[1]; + intsc[2] := pos[2] + t * ray[2]; + + { Calculate texture index at intersection point (cylindrical mapping) } + { Try and adjust the 0.2 to stretch/shrink the texture } + u_array[(j Shl 6) + i] := Trunc(intsc[2] * 0.2) Shl 16; + v_array[(j Shl 6) + i] := Trunc(abs(arctan2(intsc[1], intsc[0]) * 256 / pi)) Shl 16; + + { Calculate the dotproduct between the normal vector and the vector } + { from the intersection point to the lightsource } + norm[0] := intsc[0] / radius; + norm[1] := intsc[1] / radius; + norm[2] := 0; + + lvec[0] := intsc[0] - light[0]; + lvec[1] := intsc[1] - light[1]; + lvec[2] := intsc[2] - light[2]; + vector_normalize(lvec); + + res := lvec[0] * norm[0] + lvec[1] * norm[1] + lvec[2] * norm[2]; + + { Scale the light a bit } + res *= res; + If res < 0 Then + res := 0; + If res > 1 Then + res := 1; + res *= 63; + + { Put it into the light array } + l_array[(j Shl 6) + i] := Trunc(res) Shl 16; + End + Else + Begin + u_array[(j Shl 6) + i] := 0; + v_array[(j Shl 6) + i] := 0; + l_array[(j Shl 6) + i] := 0; + End; + x := x + 8; + End; + y := y + 8; + End; +End; + +Procedure TRayTunnel.draw(dest : PUint32); + +Var + x, y, lu, lv, ru, rv, liu, liv, riu, riv : Integer; + iu, iv, i, j, ll, rl, lil, ril, l, il : Integer; + iadr, adr, til_u, til_v, til_iu, til_iv : DWord; + bla : Uint8; + +Begin + For j := 0 To 24 Do + For i := 0 To 39 Do + Begin + iadr := (j Shl 6) + i; + + { Set up gradients } + lu := u_array[iadr]; ru := u_array[iadr + 1]; + liu := (u_array[iadr + 64] - lu) Shr 3; + riu := (u_array[iadr + 65] - ru) Shr 3; + + lv := v_array[iadr]; rv := v_array[iadr + 1]; + liv := (v_array[iadr + 64] - lv) Shr 3; + riv := (v_array[iadr + 65] - rv) Shr 3; + + ll := l_array[iadr]; rl := l_array[iadr + 1]; + lil := (l_array[iadr + 64] - ll) Shr 3; + ril := (l_array[iadr + 65] - rl) Shr 3; + + For y := 0 To 7 Do + Begin + iu := (ru - lu) Shr 3; + iv := (rv - lv) Shr 3; + l := ll; + il := (rl - ll) Shr 3; + + { Mess up everything for the sake of cache optimised mapping :) } + til_u := DWord(((lu Shl 8) And $F8000000) Or ((lu Shr 1) And $00007FFF) Or (lu And $00070000)); + til_v := DWord(((lv Shl 3) And $07F80000) Or ((lv Shr 1) And $00007FFF)); + til_iu := DWord((((iu Shl 8) And $F8000000) Or ((iu Shr 1) And $00007FFF) Or + (iu And $00070000)) Or $07F88000); + til_iv := DWord((((iv Shl 3) And $07F80000) Or ((iv Shr 1) And $00007FFF)) Or $F8078000); + + adr := til_u + til_v; + + For x := 0 To 7 Do + Begin + { Interpolate texture u,v and light } + Inc(til_u, til_iu); + Inc(til_v, til_iv); + Inc(l, il); + + adr := adr Shr 16; + + til_u := til_u And DWord($F8077FFF); + til_v := til_v And $07F87FFF; + + bla := (tunneltex + adr)^; + + adr := til_u + til_v; + + { Look up the light and write to buffer } + (dest + ((j Shl 3) + y) * 320 + (I Shl 3) + x)^ := lookup[((l And $3F0000) Shr 8) + bla]; + End; + + Inc(lu, liu); Inc(ru, riu); + Inc(lv, liv); Inc(rv, riv); + Inc(ll, lil); Inc(rl, ril); + End; + End; +End; + +{ tilt rotates the viewer in the tunnel in a relative / absolute way } +Procedure TRayTunnel.tilt(x, y, z : Integer); + +Begin + xa := (xa + x) And $3FF; + ya := (ya + y) And $3FF; + za := (za + z) And $3FF; +End; + +Procedure TRayTunnel.tilt(x, y, z : Integer; abs : Uint8); + +Begin + xa := x And $3FF; + ya := y And $3FF; + za := z And $3FF; +End; + +{ Relative / absolute move } +Procedure TRayTunnel.move(dx, dy, dz : Single); + +Begin + pos[0] := pos[0] + dx; + pos[1] := pos[1] + dy; + pos[2] := pos[2] + dz; +End; + +Procedure TRayTunnel.move(x, y, z : Single; abs : Uint8); + +Begin + pos[0] := x; + pos[1] := y; + pos[2] := z; +End; + +{ Relative / absolute move for the lightsource } +Procedure TRayTunnel.movelight(dx, dy, dz : Single); + +Begin + light[0] := light[0] + dx; + light[1] := light[1] + dy; + light[2] := light[2] + dz; +End; + +Procedure TRayTunnel.movelight(x, y, z : Single; abs : Uint8); + +Begin + light[0] := x; + light[1] := y; + light[2] := z; +End; + +{ Lock lightsource to the viewer } +Procedure TRayTunnel.locklight(lock : Boolean); + +Begin + lightstatus := lock; +End; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + tunnel : TRayTunnel; + posz, phase_x, phase_y : Single; + angle_x, angle_y : Integer; + buffer : PUint32; + +Begin + format := Nil; + surface := Nil; + console := Nil; + tunnel := Nil; + Try + Try + format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + console := TPTCConsole.create; + console.open('Tunnel3D demo', 320, 200, format); + + surface := TPTCSurface.create(320, 200, format); + + { Create a tunnel, radius=700 } + tunnel := TRayTunnel.Create(700); + + tunnel.load_texture; + + { Light follows the viewer } + tunnel.locklight(True); + + posz := 80; phase_x := 0; phase_y := 0; + angle_x := 6; angle_y := 2; + + While Not console.KeyPressed Do + Begin + buffer := surface.lock; + Try + tunnel.interpolate; + + { Draw to offscreen buffer } + tunnel.draw(buffer); + Finally + surface.unlock; + End; + + { And copy to screen } + surface.copy(console); + + console.update; + + tunnel.tilt(angle_x, angle_y, 0); + tunnel.move(sin(phase_x), cos(phase_y), posz); + + phase_x := phase_x + 0.2; + phase_y := phase_y + 0.1; + End; + Finally + console.close; + console.Free; + surface.Free; + tunnel.Free; + format.Free; + End; + Except + On error : TPTCError Do + error.report; + End; +End. diff --git a/packages/ptc/examples/tunnel3d.raw b/packages/ptc/examples/tunnel3d.raw new file mode 100644 index 0000000000..774b845379 --- /dev/null +++ b/packages/ptc/examples/tunnel3d.raw @@ -0,0 +1,217 @@ + 1$ ++ 7*$( .!4' 7/$
" (. + =(!7! :% 1 " +
=,$3& 9,#* $ - ! +9( 0 -!3! # 0# "1#"( 4&%91&. 7)(
?)&<&#%+!#80%*/ ,2
=++# 9# " 0&$9+*
, ) /" 8' ='):$& +&5$
;*")
>,(<*&) $+ "! 9''!) 4"##:-'. +>(%8"!;%" 1 ' 6$ $ + ' 6$$
+ (
. 7%!" + (=+'9,&* - ! +9'##0 -!3!!& 0"!#2$#+ ! 8&&</) ;))
?(*<%'&:.(*/ ,2
>,,#9"$
, ) /! 8&" 5# ;)% "4" :($:-$1."='$7 ":$!4 $ +
6% ' "3 0$6
% % + 7%%/ ! :((?'&?$#%. #;.%2 /5 ?)+& <! $ 3%$<**0ÊÊÊÊœ,³˜±†’½½‡‡{‡‡‡°{u²†˜Š˜†²r”©ËËìËžž.µµ}µžì©ÞÄƈ·ð°‡½’’t¼’_·i{{°{u˜‚ÅggÅÌÁqFF˜Dt ’½V‡½½‡²’±˜˜FœÃ‹ÁÁ ’ɾð{‡½’†±À¢7xx?ÁMÃw~qʳzFqÃœ +z'³Ê~‚ÓÁÁÓ‹~xÌxxÁxÁÁÌÁÁxÁxxxÓ¦¦‚qÀ’®”Þ©H´Â!ŽÛ•ŽÂ«€Â[¹GHĈ”ðÉèÞìÄËÄÞ¾·ð®{u†z³ÃwÃÒ,œq~]¦?x]MM‚‚q¼{”¾””®‡t±z³ÊÃ~~‚ÃÊq,³"“U† Ÿ½½‡²‡u‡²’t±˜†²{kˆÄ.žË.ž.žcH¨-}µì™™(û›·ð®uo½9¼†²ð·1·ð°{°½˜þgIgí–~œFzU± ’V½½V’’†'Š Êþ‹7‹j¾¾®{’’†±Š q7x?Ì]‹¸Ã¸ÃÃ,³z0qYz'˜œÊw~~]~¸~x–?xêx¦x¦?¦?ÁÁÁÓ‹Óêê‚qŠ’r·™ËµG«€lŽÂ€««€=…ùÞ¾ðÉ”·ˆ©ËìË©›¾·r{‡š¼³ÊÒÊœõœwq‹]–]ÓÓÓ‚‚œ†ð·¾·¾·®‡tz³³Ã~‹¦–xx]~wqœœŠ““ ’ ’*½EštU†V® Äžãž.ì.žžHµ¨-´´´â}µË©(ˆÄ¡d{½’’†h{i1·_®{{‡²"‚gggÌêÃ,z'†*’E’†tU±˜Š³,qÃ~‹‹ÃYˆÄ›{½±¼˜z³qêmÌ\?–ÓÃq~‚ÃqFz³³Yz"±'zFœ,ÒÃÃÃM¦?‹M‹Ó~‹ÁÁ¦x¦Ó‹MM‚qq “½ð·Þ©H}«€ŽŽÂ««…´:HÄ”Ér®ˆ™Ëž..ËÄèÖ½’˜³ ,Ê,œ“˜“œq‹êÓê‚qÀšð¾·¾¾@’˜œœÒÁÁ–ÅvÌ\–‹‚Ãq,À'“¼††t††š†t†t’°·›©..µ.žËžËžù}G´|¹|´}J©ˆ¾ˆ·ð®½o½½‡ðÆnð{®u½±þÅ‘gªÅÁÃœF“Dt’V†U˜“zŠFœ,q~‚ê œ"’#›Ë𽼊Š³Àq ¦<ÑÑÌxêÃwÃ~qÃœ +˜"zYzD±±³,ÒÃw~‹–Ówqw~]~êÁÁ‹‹Ó‚MMqqœz±½É¡ÄËù»¹[€ÂÂ…|T¨ìÞ_r{rÄìHµHµÄˆÉ{’†±Š³Fœ,œF±’E²±zFqÊÃM‚qz½ð#”@r½¼³ÊwqÌÌvg>vÑÑ\?]]qq³³"“U¼'¼D¼D†’ð..ž.ËËìËì.žµ
´»¹¹||ŒJ(èÉð®{{‡½‡{ð·©ÄÞ¤É{{{½V¼ÌÅÿggÅ–ê,F'±†š¼˜ŠF³,œÊq‹~qœD”ÄÆ·{z,œ,qM¦mÌÑíѦ~ÒÃq~‚~qz'˜˜³ +˜††±'³,Ê‚‹xÁÓÊáÊqÃ~~êÓêÓ‹MÃwq,Àz†‡ð¾ÄË.}-|€=…»´TµÄ¾r{{{›©H-ËÞÖ†U“FÀ³0YÀ +¼½{®®{½tD³,q~¢F’®{@®0Ã7Á‹Åg>g>gv\v\?¦‹qʳ +“˜U±"˜"±Ut’eãž..ËìËìËìžJµ}:´|¹¹€¹TcÄÞ”ð®d{{{o®riÞÆ™k{Ö{½’U3ÁÅÅÅÅ–‹á³'D±DU˜ +³À0œÊqÊ‚‹‹êÊ"EÜÞËĽ“œ‚øÃ]m?í–ÑÁÓÃ,œÊqÂʳ˜U˜ +˜“D†št±'Fq~xm–]³õ,áÂ~~~‹~qÊœœ³˜†‡ð·Ä©.H}´T|»TT:žËˆir‡‡®¾›.µ-´G}ãÄ”{’¼˜ÀF³œFÀ'¼E{ðd‡*“,~þq³†’V’VÖ†À mÌѪgggg>g¬v>ªÌ‹‚qFŠ"¼D“'“'“'† { Æ÷H.ìË©ËìË;.žJµ»G€€ÂÂ=¨.®‡‡{‡‡Ö®”Ä웈·r{Ö’½À~‹–ÌíÁ‚Ê,z'D˜"˜Š³,œqÊq~Mê‹êÃœ±{ˆÄã›®†,‹Á]‹Óx?ÑѦÁê~œ,³,q¢F˜±¼˜"±¼šV’*t±q‹¦ÌÑÁÊ'z,œÊÊq‚w‚wqáœFŠ˜†½®”›Äì.}-G»:¨
}HÄÞ¾®‡‡‡®·Æù…G:HÄÖ’“"³œÀY³ +“¼’‡{ð®{š"œþ~q0“U“U’ Y <gggg>>\Ñ\Á¦q0³“'¼D“'ŠŠ"¼ ®WHH.ËìÄËìËžËìžc»¹€ÛÂTHË”ð{½½½½Ÿ{®”ÄÆÞ™·—r‡ ’’YÊ‹‹ÁÁ~wÊ,z'zÀF qÊq~Mꋦ‹ÃÀ*dÞìˇ“~m–]x?\ÑíxÁ‹qáF³FœÃ‚ó"±D¼˜¼D’½²V²˜Êê̪ÅíwÕ˜'F,qÊÃqÊÊœ,œ³z˜†‡®ˆ™Ë.c}}:¨ŒË™¾Ü{Ÿ½ý®·ÆJ«|-µÄ¾{’¼zÀ,œŠ“'¼†²‡‡‡‡‡*“œ~¢Ê z +À"U“ ªsÅÅ‘‘g‘ggggÅÅŦ~q0“U†’t¼'ŠŠFŠ†÷.Ë©Ä©ìJìù.cµŒ»´«€Â=Ë·®½š†t¼†Ÿr¾ˆÞ›¾®Ö½ †UYq~q~qÃq,³FÀÀ ³ ÊqÊwÓêÓx–‚œ˜‡ËtÃmvvÑ???Ñ??ê~qFzzFœ3âqz¼±†t†¼††‡®‡±YqmvIÑ‹,D±'zFœÊqqqÒÒqF³Y˜¼½{”ÞÄì.HµHcH.©Þ·ð‡‡½½{®ˆŒ-…Q=Hľ֒“ ³zF˜¼t†t††š½²’t¼'Àz“"Š +“"¼<g‘gsgsÍ‘ggggvªÅm qÀ'’²²½*†˜ +ÀÀU‡ð+Ë.ËÄ™ÄÄì.ù.žcH
:´¹Â[€«HÄð‡±¼“Š““Ÿ‡®”¡ˆˆ¾”®Ö½½ ’“F,,,,,,³³Y˜ +³ +À,qÂMÁÓÁ¦~³U°ËËÞ® +êÌÅÑÑ??Ñ?x~q,F˜'zÀÊ‚qq +˜t’††t’½‡{uV±qÁªgg?qDD'zFœ,qÊÊœ³³z'¼½{ð¾ÞÆË.ž.µJìÄ޾𗇽½‡{ð1»QÂQ…˾{’“Š³,z˜'t’²’’’’’½’š t'†††˜"˜Ìs‘g‘‘‘‘g‘ggªgÅmþq"¼½{®®{‡½†“ŠÀ“’r·ÄËìÄÄ©žHµŒHŒµŒ}¨´«[=G.¾‡’z³À³ÀŠ¼½{ð·1ð‡½ ’ E*†±¼±˜±˜˜D¼¼¼†††““³w~ÓÁxÁêÊ“šð›Ä·’q–vvvÑÑ?Ñ?êM3,Š'¼D¼˜ qq³“t’½²’’’½½{®{V˜‚íÿÌ‹,±*†DŠF³³³œ³œF³ +˜¼ {®É¤¾™Æ©ËËËĈ·_®½½’’½{”Þ.¨«[€Ë¾®’¼³³z"†²½‡‡‡{‡{{‡{{‡’½‡u½ŠFFêÅf‘sg ‘s‘ggggÅÿÅm Ê“½@ðððu t“Š“‡”›ÄÄޙ˵HŒŒŒŒ:´…¹=¹:Þr“ ,œ ÀŠ¼†½‡rð”ðr{’¼¼Ut½E²EEu°®°{{‡ ¼œq‹Á?¦xó¼{·Æ.Þ®“‹ggv>ÑÑ\xMqŠD¼††zYœ¢ÊÀ˜±²‡‡‡‡‡½‡{@𮚳‹ÿ>gÌq'*D“zF³z³³³z“'¼’‡®Éð¾™ÄûÄ©Þ”ð{½’†h’‡_Þã:|[Û[=Ë·r’¼zÀF˜tš‡{°®®®i··®{{¼œÃ¢‹sg g‘s gÅ>Å>Ìmêqt‡r···ð{’t““†‡®·(™©ËùHŒ}ŒŒ¨¨´G…GH”½³œqqœœÀŠU¼†½‡‡{{‡½†'z'z'±t’²u{d®···¾ˆ”r{½' ~‹x?–Óq’®è·V3Ìg>>vÑÑ–MqzD¼D†št±zÀœœÀ˜¼½‡{®{ÖÖÖ®Éðd’qÌgŪÁ,t’št˜˜˜zzz˜“¼ ½‡rð”¾Þ›™›ˆ®{‡’t†t½{r¾ì»=Â!«-ˆ®’“"z˜± ‡Éð”k”¤Þ©.HHËð®{½˜3‚ÃqÁÅg‘‘ ‘‘‘Åg>ÅÅ>Ì–‹qF†‡ð·››·{’¼¼’‡®·ˆÞÄìH¨-¨Œ}¨-¨T…G»-;A¢Ãq,À³Yz“˜¼t†š†t†“z ,3ÊÊ3œF˜¼š²°ð·›ÆÄÆĈð‡¼,~Á–?–~œD‡™Äɼ Åg>v>Ñ?]ó±t’’t t†±ÀœYz±½u{®®ðÉð”Úd±‚Ågg–Ã"*EV’t¼˜˜˜zz'˜'¼†½‡ÖðÉ·¤·¤·¾ð®‡½š†±††o{”ËT«Ž=-.r’“zŠ'tÖðˆÆÄÆ©ËìH-GQËð®u’³‚ÃœœÁÅ‘g ‘g g Ågv>>v\xêMœ'Ÿri¾n›n·_u’9½o®iÞ©¨G´T´:´:¨¨¨´»G»Þ½ ~qœzz³ÀÀz˜¼±¼†¼˜³ÀœÊq~‚‚‚¢qq Š˜’‡ð¾™ËìË{ Ë?–Áʆ{Äì› <Åg>v?x~œ˜tV½*’*’š’†±Š³³“±’½®Éð¾¾·¾····u˜–ÌÿÅ7F†u‡Eštt±±˜'˜U±U†’½‡Ö®rÉðÉð®{½’†±¼±†tŸ®”Þ.-»Âl¹-Jˆ®†Šzt²ÉÞc-:
:¨:T»=:Ëð‡’¼œþqz±Ê–g‘g‘ ‘gÅ>gv>vvÑx‹ÓÊz’‡É·››{o½½‡®ˆ.«…G»:}:Œ-´:H¾†¢¢q³Dt˜zÀz +˜¼t¼±¼˜ŠÀFœÊq ‚êm7¦‚¢ Š4½ÉˆÄ®†,~Á–?‹¼*®ÄLW½ g>>?‹w,±½²V²V’’*’št¼zÀ˜˜†’‡É¾ˆ¾›·š~–Åg–ÊD’C‡²’št±±˜'¼˜¼U’ Ÿ‡‡Ö_rÖ‡’†¼±“˜“t’½ð¾™.:…=ŽŽ!=-.ˆr†Š³Štu.G€«Q…==«TTc(®o¼Šqê±d*FÁg‘gÅ> v>>vv\Ì]x‚ᆒ{ɈˆÞˆ·ð‡‡‡{®¾™;¨T«€Â€……»T¨}µ
¨-˼3Ãz²u¼ +ÀŠ˜¼†††††¼††¼¼“¼“ +FÊ~Á‹‹‹~Ê“’‡É{Uœ~x––~0¼‡©û1˜ÁgvÑ ÑÑÌ‹ ¼’‡‡½’’†’½’½tD±'±±’½½{{É·ˆÞÞ+Þ›¾Éz‚ªÿªþz²°®°‡²’†’±¼±U¼††’V½½‡uu²²U˜"zz˜±†²®iˆìµ«ŽŽ¹-Ë·{† +À“’®
==Â[…=…»T.(ðÖ†Àþ7ʱCE˜ÃÑÅgÿ>bvbvgvvÅ>Ñ?‹]Ãœ˜ç½{k¾¾¾r{{‡{ð¾™JG«!Ž!«´»¨µùcŒTã·†œœdd’UŠŠ˜¼†š’’’½½½ŸVŸV‡½E*D'³á,‚~‚0“ Ö®½D Ó–Áx†‡Æ©¡{F–>>vvÑÌ–~F½‡‡Ÿ’4†’’½½½²†±±±’’‡‡®ð”¾›ÞÞÞÄaÞ”q–gíêt{C{°½½š½†¼t¼t†’†š ² št"“ +zY˜±š‡_·™Ë¨T«ŽŽÛ=âË·{†ŠŠ˜‡;Œ«»TT¨TT¨T¨J™{†Šq œ*ÝæÅ\gÅÑÅvvvÅvvvíx¦Ó‚óz†½rr”Éð®{{{{ÉŒ«€•¿lŽ€´G¨žËÄc-.½À¼{·Ú²˜ +Š˜±†š½u‡{{{r@É@”¾ ”É®‡ ˜Y3qþq˜tV’'qÁÁÓ'’r·Ä1E‚ÅÅ>vÌ?‹q¼ ‡’ ¼U†’½V‡½ š†tt’½‡{{𷈛ޛÄËĈuêª<Á ±‡u{{{u½‡š’ ††¼tU±¼±t±D˜Y³Y³Àz˜†½‡iˆ©µ…ÂŽŽ€QÄ·{†Š“†°·ËHŒ
cùJccHH.™¾®½“3þœš³ÃÓÌíÌÑ%––Ñ?ÑÌÑ?‹Ó‹ê~ ³“ Ÿ{rðr{{{Þù»ÛX‰6•€«»´
ì™(ìHØÄ{¼²Æ· ³ ,À¼’½‡{{ðð··ÞÆaaÆKð@²"œq0˜¼¼qÁ?Á~,UŸð·Þ¡ý±ÁgÅ>vÌ?Á~F†V‡½†±“““U’’‡‡u‡²†št½u‡{{®É·ˆÞÞËËÞ±‚̪êœD‡°®d{{‡‡E½šš†tU†¼¼'“'“z³œ0qYz +±šu_·nË}G…[ŽŽŽQ|Hć¼“˜†®·ËìËÄè(™(Ä;Ë;HHžÞɇ’YqYtËm?–ÁÁxÁxÁxÁ]–¦‹‚‚~‚Êœ +˜ VŸ‡‡‡{®r¾Ä¨«•‰é‰l¹´GGµÄˆ”ˆìH}Ë”’‡ÐÚ±q~wÊœ˜*½{®ˆ›ÄHcH
.ÄÞ¾‡¼œ‚wqŠŠFq??‹ÀDð¾_‡F–ÿÅÅv–x‹q²½ 'FœY˜† ‡{{{½½’’½uu{{®ðð”·¾ˆÆËËÄq<Á7 ¼u{®®{‡‡u‡²½’††¼±¼“zz³œÊqœ³“t½{ðèËžŒ»=ÂÂ[Â-.𽼓¼½d·1ˆ¤”k¾¾™ÞÆ©žn{½ŠœF'œ~êÓ‹¦Á~~‹M~MM‹x‹¸ÃÂqÒÊ +“¼ ’½½‡{®Þã…Ž¿º‰¿Ž«»--HÄkrkÞ.H.ˆÖ{›ðê?m‚ÃœYzUt’‡®ðˆ›ÆJ.c:-:HÆ°±œqw, œ~Á]~,‡®Éý¼qÌgªgvÁÓ~MÊF¼†¼œ,3Ê +¼’‡‡Ö®ÖŸ½uu{°{d®ðð¾Ä.ËÄtœ~7qÀD‡{{{{‡‡{‡u²½*†’¼'ŠzÀœ3qq q0z"š{_·ÄL
G««ÂÂ…G}ľ®’““t½®ðܮܾ¤ˆnÞ™ÆËû›ˆ®½“0³œ~?Á‹‹Ó‚~ÃÃwÃÊÊqÂ~qœœ0 Ê,,YŠU¼’½{®”·ì-«•‰‰¥$¹G¨}-Hɇ®”n.µˆÉÖ¾›°F¦vv–Á‹wÊF˜D†’‡{®ðˆ™Ä˵c
»»:c¾°˜œq FqÃ]xÃœ' ‡ð{’À‹ÅgÅvíÃÊqÃqFz'zÊÃ~‚óU†‡Ö®ÉðÖ‡‡‡{{{{®ðÉk¾èĞ˩ ÀÊ¢œ +†½²‡{{{{{u{{‡‡½’’†“À³qq¢q3À“t‡®·ì}T…«««´-ž›É{’¼¼’½dið_{®Éi¾·ˆÞ›ÞûËÆ1”ð‡±0³DÊÁÿѦÓêÃÃÃÃÊÊáœõ,,qFŠŠ˜,F³ +"“U¼’½{ðiÞ.|•º‰•Ž¨HžHH.r’‡Éˆ..ÞÉr¾{,m>¬gÑ–‹~ʳ“D†½½{_𾈙Ë;c:T…-µÄðt³œ œÊq‹MÃõ“V{Ö‡¼3ÁªÅÿÅÁá,qÊq,ÀÀ³Ãw~‹ÃÀ"†{ÉÉrÖý‡{{{r_rð¾ˆË.ËÄðEz ,À“t’’‡‡‡‡{®°{{{{‡u’’±¼zÀ,œq3³“t½{Äž¨´«…|:}.ˆ®‡†“†’‡®ð®{Ö𾾤™ÞÆËLÄ·ð‡UqF˜Ê\Å?Á~wÃÊ,FFFFzz˜“U†’†*tU¼¼¼’Ÿðè˨=Ž¿¿¿€»}µJ..žH.Þð½’o©Ë™rÉ·{Fmvv>g>Ì–‹Ãq,³Š“¼†½‡°™Ëù}:»G.ˆÖ†Š,0œÊÒÃœ'’‡V½U³¢Ì>g¦Ã³˜œÊ‚q~qÊÓM‚M~ÊŠ’‡rð””®®®®r®ÖÖrɾÄ..Ĉ°’D¼“˜ +“U†’½‡‡‡‡{‡‡{®ð®®{‡½’†˜ŠœÀŠ“†½®1ÄLH}:»T…|»-Œ.ķɇ’†’²‡{®{{֮ɾ¤¾¾ˆÞÞÄËË®{˜¢ÃÊÌøÅ\ÁwqÊ,FF³Fz'±'¼’u‡{CdŸV{ð¤›ÄµÛ¿¿¿ŽŒ.;ÄìË.ãË·r½’½ÉÞÄ5”ýÉ®'êv>g>gvvÌmÁ‚q,À“±†š‡ýðkˆ©JŒ»ŒÆ”½¼ÀFœ,œáDt V†UŠ¢¦ÌÅÿÌ‚,˜DzFqê‹‚‚‚ÓM~~‚ÊÀ"½‡É””¡”¾”ÜðÉi”¾™Ë.숔{E†±DŠŠ˜Š¼†½½‡Ö®{°{{®®{{®{{‡½t¼˜“¼’‡®Æû.c:´T»»}.™É‡’†’½‡{{{ý‡®É”¾¾¾ˆÞÞÄìËÞ1ð®‡"qóígvÅx‚MÊÊFF˜'D¼t’½{®¾Þˆ¾””””¾›ìH´[•¿XŽŒž™ÄË.}.ˆr½’½{¤›ˆkrrð®’Ê–Åg>gvgÅÅÅ–¦‹‚Ãq,³zÝtE‡®¤ÞžG:.ÞrV“YœFF˜DšV*† +œÃ‹ÅvÅÌÁq'†*¼³¢‹¦–¦‹]~wÃÊqFŠ ’®ð·ˆ·””¾ÞÆĈr‡š±D¼z +À³Š’‡{®ððð®®Éðrrðð®®{‡½½½‡®ðèÄ©ËžH}
:´´¨µË™®‡’½u‡u{{‡Ö—𔾔¤ˆˆ™ÄËĈ·®®‡˜q~,ÊÑIvª?~w3,³˜'±’*‡ð·ÞÆã÷÷HËÄÄnÆìH=Ž•XÂ…ŒJ™Þèž--H›ru½½{¾¤¾ýÖrð°U‚–Åvg>gvªvªÌm–¦‹qqÊFz˜¼½ýɾìc}H¾ÖŠY³Ýt*šŠ¦Ìªgvm~tEut"qêmm?¦Ó~wÊq,³ +˜U’½‡{ðð¾””ð”ð¾É®Ö’“À0³YzŠzŠFŠ“†²‡®···”·””ððð®d®®®·ˆ›ûËËìH}
}:¨-Œ}Hì”®‡’’’½‡‡‡‡{®É”k¾ˆ(ÞÄÄÞ¾®{²Š~qFœ–>ÅvíÓ‚Ê0Š'¼†’½{®¾›Ë-G==…:}
žH}-…[•$ÂÄ™(Þ™.}G´-µÞɇ½½‡_¡¤®o{ð "xÌÅ>ÿgvÅgvÌí–ÁÁM~`Ê,z'’u®ÆãHÉVUz"t*š“FÊ7–Ìv>gvÁʘ’½‡½±œþ?mÑ\Á]qÊœFÀFŠz"D†*š½½‡‡{‡‡u’t˜³q‚¦m¦‚qFz'˜Š±t’½{·›ÞÞÄÞ›ˆ¾¾¾”””ðððÜ”¤ˆèÞÞ©ÄËù.µ}-¨µËÞ{{½’š‡½½‡‡{{®ð𔾈ˆÞÞÞˆ”_®{½zqFõÁ\Å>Ì]~3,³ +˜D†*²®ð¾ÆHâ¹ÛŽ!Â|G´G|[ŽŽ=5”(™-…GHÞ”‡u½½ð¤·_Ö{É ð FÊ]Ìgvgÿ>ÿÅÑí?¦x ~ÃÃà z“’”›Ëˈ”†U*šD˜‚<ÌÅÿ>>Å?~³U²‡E†³qê–\ÌÁ¸Ãœ,³Fœ‚‚Ãþ‚3YÀ +ŠF ÊþÁígÿgÿ–‚,z˜±¼D“˜Ut½{ÆÆ.ËÄÞĈ·¾”k·¾¡ˆˆÞ™Þ©ËžJµ
}}÷™·®‡½’½‡½½½½‡®®rðɾ¾ˆ¾ˆˆ·É{{u’YqzÓÌÑÿvÁÓÃ3,“D†t½‡{ð¾›.-…«ŽŽ•Â«Q|´QÂÂ[…
.ˆ”¤ˆËµG»}.©¤r‡‡½²‡_ð¡_{ð#W#Ku*w‚–\>ÅvÑÑÑ?xÓ Ù ÃÃqœztu·KðV4D†˜,qígÅg>>v?ÁÊ'šE{{‡’±Fq]xÑm–êÃqœ,3~ê–ªÅÅvg<Ìm–¦–m–\Ì\¬v\x‚Êz'±±±˜Àœ qÀz’½É¾ÄË....ÄÞÞˆ·”””k””k”¤ˆˆ™©.µ¨-Hû¾ð{½ ²½½½½²u®dð®ðð··”ð{{‡½¼œq,zóÃÑ>Å]Êœ +˜"t’’½{®ˆ.»…ÂŽŽÂ=¹…G…«[…:JÞk¾Äc-¨-µè”rŸ²½’½{_i¡ð®ð#·aàÚuDFÃÓ–ÑÌ?x–x‹Ó ` Ã~‹qqqzt‡·ð® UUU¼Fþ–<Åsÿ>gvÑxw³½u®®°‡š˜³Ê]?m‹êqÊqÂÁíÅvÿgÿgPgPŪŪg¬>¬Ñ]MÒʘt±±D“Fqq7¦<ê¢ ¼½ÉˆÄì..ìËÞè·¾iðÜÉÜÉÜ”5¾¤Þ©ËžG´´-µË{½’½‡½o½²u®d®ððð”ÉÉÉðr‡o‡’“œÃœ'ÒÁ?g\–Ó‚Ê,z˜D±²½ÖÉ·Þc:GG´-´¨:´…
ùÞrÉ›÷â-÷ˈð{{‡u’’½’‡{·¾·¾i”1ûÄ©ð½“qêmÌmÁ¦‹‚ʜʜ,qÃqÃq³³±½°½'',‹ÅgÅgggÅÌÁœz¼š‡{r®r{‡’†z q 7–xÓww¸ê–<sgÅ>>>gvÅv>vÑvÑ–x‹ÓÃÊœ³˜z³œ,q~Á–ÌÅÑ?ꜱ°·©žË©Ä™ˆˆ¾Éð®Ö{rrðkˆ™Äžµ¨T…G-÷Ä·r{‡š**ý{®r®®Éðð®{{{{{‡u²tzq ³˜˜Fq¦\Ì~q,³˜"±t’½‡rˆÞJJHص.žcžù
¨-žÄÉ®”LØ÷޾ɇ‡½² ’ ŸV‡{É››è·¡ˆnËžËð‡˜,¦–¦Ó‚Ãq³FÀFœÊqÃqqqœz†u½†F,Ê~ÌgggggÌmÃÊŠ±‡‡{rðÉðr{½h˜À3 ÁÁ]¸¸¸‹míÌÌ??%?Å>vvÅÑ?–xÁ~øqqœ,qÊqÊq~¦–ÌÑ–]œ±½®·™Ë©Ä©ÄÞè¾ð®r‡‡Ör”¾Þì.µ-»«Q…ⵈrÖ‡½ š‡{rð_r®ðÖ{Ö‡‡‡‡V½š±ÀÊq±D˜q~]mx]~qÊF³z'¼†½½{ð·ˆÞËÄ©›1ˆèÞ©.µ.ľÜr”Þ÷ØÖ‡½4†št½V½V‡{ðɈ›ÄË©Þ™ÆË.žË›Vz~êÁ‚Êœ±D˜³ÊqqÊ‚Ã3†½’“FœÃ‚–ÿPÿÅm‹Ê±š½‡°{®Éð””ið®²h"À‚Á]xÓ]7‹ê êÃwM‹Ñg>gv>vÑÌ?–Á‹ê~qqœq ,œ,qÊ~‹xm¦~qz†‡”©Ä©ÄÄûˆ·®®‡½½½Ö{k¾èÄž
´´=Â[«-.›¾”®Ö{½*²‡r®ðð®®{‡‡½’½½’’šDzœq z¼±qÃêê‹‚ÃÊœF³Š˜¼¼†’½Öɾˆ¾·Éð—Ékˆ;JËè”Ö·.Ø.·r 4U¼U†’ ½‡Ö‡®rÄL.ãìììËË°±qÃêó'tššDzFqÃqÃqqz¼°®½“F,Ê‹Ìg–Ã0˜E‡u{®r𔾤·ˆ·_d½,~?¦]ÂqFÕõ~xb>vvv>vÌÑÌ?ÁÁ‹‚qqq,³FŠ“zõ³Ê,³z˜†‡_¾ˆˆÞ©ÆÞ·”{‡½’’½‡ÖkÞì.´=ÂŽŽ[¹G}ËÞ”#r{Vš½‡{ð_É®‡‡’’’’† †˜z,qqÊŠ†t'zœqwÃœ0F³³z'“±†’½{ÉÉ®{‡ýÉ5ÄË™®Ö”™÷ã›{†Š“"¼¼¼tš’½{{r®É¾ÞËH}cµHcËËãÄ ½F¢~q“t‡Etqø~êq†·®†œÃê–ÿgª¦ÃŠ Eu{®®®É”ˆ”¾ˆn›™ð“qÁ¦]‹qqÃYDDFÃ?b>gvbv>vÑ–?–ÁM~qÃq, ³À¼'¼'"˜'˜z"¼’½{”·¤1··ð®uV’†’½‡{ÜÞ©H¨«Ž$Ž€¹-µËޔɮ‡šš‡{ðð{½’††¼U†¼¼“F³qâœttt'z³Êqœ,,,œ,F³ÀzŠŠ¼†½‡Ör®r{‡ä‡ÖÜÞìˈɮˆ.›{¼ŠÀ +A“““Ut ’{®®Éð¾ˆìHT´G¨µËÆ·“Ê‚,¼{°²'œ~ê‹êê0˜½É‡'FÃ~ÁÌÌ–~Ê"VE½‡®ðɾˆˆÞÄËÆû ½FqxêqÊq³'FwÑg>>vvv>Åv?–x‹~Ãqqœ³³À“±U±U±tš²‡®ð¤”ðÉ®{‡’t†t¼†’‡{r”èÄž…=Ž•••$€H©ˆ¾ð‡²’‡{_ð{‡’†¼¼¼˜¼˜ +³œÊq~q,˜¼t t˜ +³œ,YœY,œ,³,œFz“¼’‡®®®{{‡{—¾.Ë›®”Þ.Æð†Š ÀA +"Š'˜±†½‡®ððÉð¾¾ÄJ¨…=…T}.ËÄ·®D ¢F’°®³w¦xê~‚œ˜V®··”®šzq‚ê‚¢qŠ˜†š½V½‡{®ð𾾈ީĩì.žÄ@† qqœ³³F³,~Ì >>gvÅv>vÑÌÁ]~ÃqFÀŠ“U±†U†š ’²½V{ð”·ð‡’t±˜z˜z±±’½½®ð¾Þ.}-•$••Ž…
žÄ™®½š‡{ð®{²†±˜˜Šzœ,qw‚Ãq,ŠD† ’t“z +³YF,œÊœ,qÊ ³“±’‡r®ð®®®”™.}.©·¾Ä›‡“œ À +““ +Š˜'†*‡@ððÉɾ¾Ä.¨«=€…T}.®±ÀÃÀ²@ð®záê?¦‹‚à D½®”K·É'Ê~Ã,F* * ²Vu‡{®ð”¾ˆÄÞ©Ë.ž÷.ÞV˜0œzz'±FÖg>ÅÅv>>vvÅvÌ?–Á‹~qqÀzŠ˜U¼† š½ ²V²‡{{rð®ð{½t“³ qqœF³¼±’’ý®”™ËH¨ÂŽ•••¹TcË¡®o²‡{®®{’±“ŠŠzŠ³œqø~qʳ +˜’*’†D“zFF,,ÊÊÊqÃqœF“±’u{{@ðð”舵-HË›¤ÞËÄð±qqœ +“¼"zz˜†t½‡ððÉ®ÉÜ(cT«=Â[QT.›· 0¼V®®’Õq–m‹¸qÃzŠ¼V®¾¾°š³qÀ˜†t’š’’’ ’½‡{rð”¾èˆ©Ë.ž.HµH.r½4’E±FqÌggÅgvvÅÑvvv\vm?mxê~q,³ +“¼†† ’½V½‡½‡®®®®{{’¼œ‚êÁÁ–ê~q³˜¼t½½®ðˆ©H-«[Ž$ŽÂ¹¨¨}c›Üuhu‡°‡u’±Š'zF,œÊq‚M~M~qF¼š½*’†±Š,ÊÃq~‚~qà ³˜†š‡Ö®ðð¡›;G€«-µ›ÞÄ{Šq3³˜¼“zYz¼²®ð””¤ÄcŒT…[Â…Ø.›† ʼu®{†FqÁ]‹qÃœ³¼’{”¾dV˜YzD’E½*†t’*½½‡rðkˆÞÄË..µH}ãÄ”{½½½utœ‹ÌgsggÌÑÑÅvvÅÑ?–]‹‚~3œYz'¼’’½½½‡½½®{®®{‡½†z¢¦–í\vmÓq,³z'“¼’Ÿ{”ˆËc¨»««Â…´T»Tž·²‡‡u‡½t“zzŠ³œ,qÂM‹¸ÃÊFŠDt ’*†t"ÀÃË‹ÁÁÁê‹qʳ"±V‡®ð·1·™ËŒ[¿´HìÞÞ·’q‹q˜š†D +³F³˜“’°®”¾¾ˆ(©c-»Â=»-Æ·³ ¼{‡¼,q‹‚Ãœ,³À³Š½®#·{¼“¼’²‡²’t¼Ut’’‡‡_®”·èÞìËžµ}
-aÞÉr®®ðÊmÅsvÅÑÑÌvÑÑ\Ñ–?Á]~Ãq,z“¼±† ½’V½‡½‡½®@{®‡½š˜œ~íÅ>g>Ìm~wʳYz““†½{ðÞËc
:»G´:»…«=©®o½‡½½š“Š³FœÊqwMÓ‹Mq,˜š*†±'zœ‹‹¦ÌÌ?mxê~qY˜’²{ðÉìµG•º$¹-µ.Þˆr¼‚êqD²š±Š,³,Š"t{ð””¾kˆ(ì
¨»»G´-Ɔ 0t½{½ŠœÃ‚ÃœF³³FÀ“’‡É· d tUšuV’˜“Ut’½‡{Éi¾›Þ©ËµH}:GG-HËÞˆ··t¸ÅgssvÌÑÌÑvvvÑ–Á]‹Ãq,³Š'±’½½½½‡½‡½‡‡{®š†“œÁª>ÿ>>Ì?êÃq,³³ +˜“¼Ÿ{ˆ;;c
}Œ-»…[Û|ã_o½½‡½’†±“z³³FqÊ‚~ÓÓÓÓÊœF˜Ut¼˜Àqx?ÌvvÌ–xêÃœ˜¼ ‡ð𤙩ž¨Â‰È¿«»µÞˆ{Š‹êœ±Cu*˜œF³³“t½‡®·¾·ˆ¾èÄùHŒŒ-´GØ›{±Y³†½E’ŠFqʳFzŠzŠ³ +Š¼½®r½†††½{½š±“z˜¼t’Ÿ®ð”™ÆËž.}
:|GG
cJÞÞ·*~\g‘ vÌvvvÅ\Ñ\?Á]~‚wqFz'±†t’E½½‡½½½½½V‡‡{u’DzæÅ>g>Å\–~w,œ,FÀzŠ'¼½{ð¾(©Ëì˵HT…•€.ð½½½½V½“'“zF³Fœw~ÓÓÁ?Á‹~Ãœ˜˜'³q‚–ÌvÅvÌ]Áq,³'†²‡®_”¡ÞnË}…•È‰[|}.Þ”VÀê‚Õšdu† Êqʳ +¼*½{ð·ˆÞÞÞ™Þì.¨¨T|GH·½“ÀŠ*’’†À +³0z"z''˜"zŠ“{É®‡’††½‡²’±“zŠ˜¼’½Öði¾nÄì.H}G»G:-ccËÆš¸Ågg‘‘vÅÑÅvvÑÑm?]‹ÓqÊœFz˜D¼*’½½½½½½½½’ ½V‡½ ±˜,q–ÿ>gvvÌx‚ÊœFF³ÀFŠŠ“†’‡—”¤ˆˆ™ËJ…=¿X€Ë_o’’‡½½†±“Š³,q~êx?–?Ì?mÁêÃœ,œqw¦?ÑÑÑ–x‹MÊœ'¼*‡®””¡Þ©ž¨Â‰^y¿Â…ìˆr¼¢êʱCdôq‹ê‹‹¢qŠ¼†½®nËìÄì.µ»|GÆ{†z ˜’±¼±“˜ +z"±U±†±˜"zŠ†‡®#®Ö’††½‡‡š†˜˜˜±±’o‡_ÞLãµ}¨´T|G»TT
.Ë›EwÑgg ‘vÅÑÅ\ÅÑ??]Á]~wqF³˜±t’*½½‡½½½š’h’ ’’t±“zq‹\Å>gvÅÁ‹Ê³z˜'˜˜˜˜“±†’½Öðk˵[¿X|Þo††’V½½“ +z³Fœ,qÓÁÑvvvÅvÅvÌm¦Á]‚]]x?ÁxÓMq³F±’{{k”è›ìµ»Ž‰^y•«…cľ‡À7]œ²Ïtœ‹íÅíÅ7‚3F“†‡®¾›Ë.žH}G¨»´}©É’ÀÀF“š¼±¼“"˜"±t*²t“"Š¼½{É@Ÿ†½u½*¼±"±±†½{ðkûÆžH-»||TT:HÆuœ?Ågs‘ÅvÌvÑÑx–Ó‚wÃœ,³˜'±š’½E½½½½’’’ ’¼D“Fœ~ê̪>vÌvÓqá''D˜D±U±U±¼±†’½—ɈJŽXX-k’jU4½‡½†"³ŠFÀ,q~¦–>>g>>ÿgÿÅvÿí?ê]‚~¸Ãq,³“±’‡{{®ðð·™Äù«ÈR¿[«¨ž™K ,Á ˜°šYÁP‘g‘ggÌÁ‚Ú‡›â´GâØã°’z³Àz“˜“““¼±¼±†’’½‡‡’¼±“±*‡ðð®{’’½‡‡u½š†¼4’Ÿ{—¾™Äì.}}¨T´…«……«……»}ùÆr³<ÅÅ>>í?mÌÌ?Áx‹¸~qqœ³Šz¼¼’†’†’’½‡½†¼††±±±'F,ÊM–ÑÅÅÅÌ‹qqŠ±††’’’’’’’†’½ŸrÉ5©c¨ÂŽl|Þ’ŠŠ¼*²Et˜FYÀFÊ~xÑvgbggggggÿgªªví¦¦qwÊœ,z'±¼½‡@ðð·™Äì»[¿^ •«»
©è@± 7‚ d‡Fê<gsg‘‘gÿÌmêʳ†½®›™ÄÄ {†Š ³Àz˜¼±¼¼t††9’t’²‡‡{²’†±¼tu®ðÖV4’‡°‡u’’4 ’‡{Éiˆ›©.µµ:G…¹…««……»
žÄÉ"7Å>gÅí–?–?x‹]~ÃqÊœ³ŠŠ“¼†4’ Ÿ’’’“““±““zFqÃ~‹?ÅbvÅx‹œ³“t’½‡‡‡‡{{‡‡{rɾÞ;¨…ŽŽ|ž_“ÀÀ˜†½²±zFÀ,q‹?vvgÅgbÅgÿgÅÅ\–¦ê‚Ò±'¼˜¼t†’½½‡{®ð”·èÞìH¨ŽX ¿[»c™”ê¦Y°C±Á<f‘ÍggÅgÅÅ–ÁÃqŠ¼’’’†U˜FqÃœ˜˜¼±Ut’š½½o½‡‡{{®{‡½“tV°·ð‡’’‡{d{u½½Ÿ‡riˆ™Æž.µ
»»«Â…«««……µË·†‚ÌÅ>>¬ÅÑÁx¦x‹Mqwq,œ³zzŠ˜¼D’’V †U“Y +z“z³œÊ‚ÓÁx–vvÌ–~ÊF“±’’½‡{rðÉð_ð·ÞËH:|ŽÛ»Ëɼ3Ãœ"t²št'³FÃÁ–Åvî ÅÅgÅÅÅÅmê~qœz˜±@ddd®C®®ðððˆÞ©.}:…••…¨cìèÜ*¦ Dd‡qÅIs‘g‘ggÅg>ggÌí–Áêþ þ7ê þÊq,zz"±Dt†E‡{d_®{{®{®®®‡š¼¼š{ð”ÖŸ’‡®®d®®ÖÖɾ1ÄËžH}:´T…¹Â«Â«……»}ËÞ‡ –Åv>gÿÌ‹Ó‹Ó~¸ÃÊÊœœ³Šzz˜“±U±¼ +À âq0³À³œq~Áx–ÑÌÌx‹F˜˜†’½‡{r®”··›a.G…¹¨Ë—“¢þ‚,Š¼*tD˜z, q ÌÅv>vÅgggÅÌ–‹q,˜²ud›ÆÞ›Þ››Þ›ˆˆˆnÄì.µ»=[[«-HžË·—'~mqš'm‘IgÅgg Å>b>g>>ggÅÅÌí–êêÃ0,'˜'¼*½ð 1·¡¾iÉÉr®r®®‡††½‡ðÉŸV{dð®ðÉ”¡ÞÆì˵H}¨´T¹=««¹T¨.ûð“~ívŬŖӂwÃMÊq,qœF³Fz''zF,ÃêÁ–ÑÌxMœœœqÃ]xÁÑ?–?‹F³'"D¼Ut ½‡rðˆ›ÄÆãHØ-..¾{“¢‹‹~ʳ¼±±˜FœÊÊ mªgÅ>vgÅggÌÁq,±†‡dð·››ÆÆ.÷÷H.ãËLÄûËËH}:´T|«Q»:.ìÆ™Ÿ,Á‹'V±ÿgIg‘ggÌ–ÁÁ%?ÌÅÑÌvÌ–ÁêÃÃÊq, zUtE‡CKìËûÄÞ·”ðrðÉ{½’’½®ˆ›¾r‡½°®¾¾·ˆûÄ.žH}
}:´«ÂÂŽŽÂ«Â…´..·’ÊÁÌvÿgvíÁÓÃqáœ,œÀ³õ³ÕzFq~ê–ª>g>ÿÑ–qqœœMê–Ñ–x‹wœFzz +zYŠ“¼½Öð”·Äe.ã.Þ¾r4Àþ7Á~YŠD˜õ³œÃqêÅg>vvg>gÑÁñ ²C𛾈ÞÄ.H}-µ}Hž.µ}¨-»TTT-¨HË©Þ›{†~í~*E,–‘ggÅÌÁÃ,,F,,ÊM‹Ó‹Óê‹‚ÃÊ 0³Y³Š±†½½{ð·Ä.µ}-}.쩈kÉ”ðÖ½’½®Þ›É‡Ÿ‡{®··ˆˆÞ©Äž..µH}Œ:´«€ŽŽŽÂÂÂQ»Hµ›{z~–ÅgªÅgv–MÊ,³,œF³³FFFÊÃÁÅÅgg>v?‚qœœwÁÑÑÅ‹MÃá³F,,ÃÂ~ +"†V‡@® ®‡¼ŠÃ7–Ì–?xÙœŠ'zFœÃÁÅ‘gÅ>>gvÌÁÃF±²‡{®ððk¾™ÄžJ}-}}-»-»-¨HcÄ™¾¾¡‡£ÁÅÃu*‚‘ÿgsgÅÌ–`F''DDó'õÊÃwÃ~qà FŠ"t u°®›Ä.µ-G|GH.Þˆ¾”®‡’½®·ÆÞ¾{’²{d·ˆÞÞÆì..žHµHµŒ¨»«ŽŽŽÂ«»}Æ®UqxªvŪ>ÿÅÓÊáœFF³œ³³õÊÃÁÌgs>vqœ³³q]Ì\ÅxÓ~Ò,œqMê–––7ê þÀ +““’ ¼¼Š þ<7<ÅÅvb–qY˜³œq~7ÌgggÅ>>v–~,˜š½‡{{Ö_Ɉ5ˆ(©žŒ:¨T»»»»T…T:
µJÄÞ¾¾ð·’œÌíCFÅgsgÅÅ–Ã,YY'¼±˜zz³œœœœ³z¼†’‡‡{ðˆ™™©ìµŒ¨´«=…»H©¤”¤”ý’’{¾Äƈ®Ÿ ‡®¾ˆÞËÄËì.žHùžJµcµ:»|ÂŽ•ŽŽÂ«GµË›{À‹êÿÅÿ>ÅÌ]~³³FÀ³FF–‘‘ss¯sòs gbb‚œÕ,Ó–Ñvª?ê~qÃq‹vÅÅvÅgggªÅÌ–‹‹ÃÂ⋦–ÌmÅgÅg>v ,œÊ~]Åg‘gggÌ~œDtV½‡Ÿ‡r””Ü™;.JH¨-´´GG´|»-ŒJ©Þè”Érððt¢\ÁD²ÊÅs‘ÅgÅÌÁMœŠ'“˜zzzzD†š’’½½u‡®_É¡©Äìc}:T|[€QJÞèÞ·r‡’{¾ÆÄÞ®‡’u{ð·ˆÞÄìËì..ž.ùHùHcŒ´Â•¿•ŽÂ[«´
÷Æð˜Ã‚ÅŪg>gÑÌ~ÃFz³³ÀFF Ì‘‘s¯Í¯Ís Åb]Êz³¸¦vªvÑÁÓ~êÁmvÅvggggg‘gÿŪÌíÌ<í<Å<ÿÅÅÅ>Ñ >? ,œÊwqM–g‘ggg>Å?qõ±½’‡{r¾Þ©ÄHËì.c}
´T»T»»»…=«ùË(¾”r{{ðd"¦Åq‹‘ssg‘ ÅgÌ–êþq z³³³³³³z˜˜±U˜Š˜Š“¼h½ð¤™ìžc»»…«ÂÂÂÂ}Ë™ˆè”—½‡ðÞËć’’{®”ˆÞÄÄìËììËžù.cµ:»|Ž$¿•ŽŽÂ…QH.·’œmÌÅÿggªv–¸,z +³ÀFÁ¯s ¯s¯BsÍ‘ ‘Ì‚F,M–Å>gÅÌ–íÌíg Å g‘ggggg>Iggg>g\>>Åv>Ì 0œÃqM‹Ågg‘g ÅÌ‹Êz˜U†š’Ö”ˆ©.ŒccHcH¨G…|»T»T«¹[GŒˆ¾”r‡‡‡®Ú{ mÅ,²sgs ggggvÅ<77qq0œœœœœqœ3q3¦77êþqÀ“’okˆ©ù}Œ»…=ÂŽ€»J©ˆÞiɽ‡®ˆãË·Ö’½u{ðˆˆ©ÄÄ;ËËìË;.ùµc}»…Ž¿¿¿•ŽÂ…….ãÆ{zÃê–ªggvgí‹Êz'z³ÀFÃssssBB ¯B¯Í‘ ÿÁwqÁÅvggvÅŪÅgÿ g s ‘g>g>>ÿÅŪ>ªvÅ>Å>vg>xÃ, Ê‚M]xÌÅggÅ‘g>m~³'˜D¼ ŸðÞË.}¨-HHHµH»…´»»«€T©ˆÜr{ŸV‡ð šÊí'*Êg¯s s‘ ‘ggggÅÌmÁ‚wÃÃÊÊÃË‹m–ÅvÅÅm‹qœ“’{·Þ˵»»««ÂŽ••[¹©™ˆè‡‡Öˆ..›r½½‡{𔈈ĩËìJìù.ùHc-»QŽ¿‰X•Ž[«¨HžÆðœ~¦ÌÿÅgvÅ?q“Š³F~ ‘ sB ¯ ¯Í‘ÌÁ–ÅÅg>gggÅ‘g‘‘‘ s sÍsÍsÍÍgg Å>¬gvv>v>>>>gvÁÊ q~ÓÁ?ÌgÅ‘g g ÌÁÃz"¼"†’r·Ëµ»TµËì..ŒG|=|»T…ÂGcľɇ‡½{@d† gêDtÁs‘ÍÍg ggvªÅíÌ]‹]]]¦]mÌíŪvÅgvÅíêÃœ“oð1ĵ»…«Â[Ž•Û»ìÄ™›¤Ö‡ÖË.ć½u{𷈈©ÄËìJžJµcHŒ}¨|ÂŽ¿‰¿••Â«…´L.Æ·šŠÃ‹íÅvÅÅgg¦Ê˜˜³ +,‹Åss s s ¯BsÍsÅÌÅg>g ggggg‘P‘ s Ís sÍ‘Í‘‘g gg¬ggvÌÑÑvv>>vÅ?~,,3Ãê?]ÌvÅggg‘ÅÁ~q +˜'“†‡ÞH-T|»ãËÆÞÄì.=¹…T»…T¹TH©¾ÉÖŸV‡˜7qssÍ‘Í‘sÍgggg>>vvÑÑ??Ñv>vÅ>g>>>>Ñ?‹Êš®·ÆãØ»…ÂŽŽŽŽ•Û|.©©Æè®{‡”Ë.Æ{{‡{ɈˆÄìJžHcHc}Œ-¨Â!¿ ^‰¿ŽÂ»Œ.Ä›½˜œ~ÁªÅg¬gg–q˜"zŠgsssP ¯ s ssgg Å g gg‘gss BBs ‘ ‘bgÅvÑ]xÓÓxÑv>ª–¦Ãœ 0qÁ??Ñ>Åg‘g g q0˜"Š¼½®Þ˵-|=…-ËÞ¾1ˆÞ˵«=¹T»T»=´Ä¾ÉÖ‡½‡®ð‡F‘q³Ås¯‘ sÍsgggv>>>>vvvvvÅvÅvÅÅî>v–ÓÒF†C+㻫Ž•Ž••ŽŽQž©Ä™ˆ®{ÖÄ.Ë®®{{É·(ˆ©ËùHcH}}:»«€•‰ºy‰¿Ž=»¨}Ë™·ð½“,ʦÌÅggg\–Êz'˜zŠwÁÅs¯ P ¯ s bÌ g ss¯§ BBB BB ‘ ‘‘ ‘b?–ÁÓMMÓx?\>vx~œFF æ?mÑgÅgg‘g‘–~qF"zŠU‡ðÄ.|´cðÖÖÉÞÄÄ
«´::´-}ìˆÜÖÖ‡rdEÑvt0‘¯‘ s s ‘ ‘ggg‘gggÅgvÅ>>g>> vÅ>Å>>ÑxÓqztuð›.Ø…=ÂŽ•Ž•Â«»cÄ1›Þ_ý‡—›žËÄ”—rÉ”ˆÞËË..HH
:::«[$X^^y^•Â»¨Ë1·ð_‡†z,‹mvv>vgx,“ +ÀYÊ–ÿ¯¶P‘Pssssòss‘‘ssgÅ ‘Í‘ÍssB ¯ ¯ss‘ggggÅvÌ?¦qÊœF³œq‹¦¦¦qœ³³³qq¦?ÑÑv>vgÌÁÃ,F +“†ý·ûµ´|»
;”@Ÿ½r¾ÞËcG-
µJù-.™”ÜrÖðð°*‚Ñ?˜DÊ‘s‘ss ‘ g gg‘g‘ggg>g>b>> >g>ÅbÅÅvÌ]~ÒFtuðË»…«[ŽŽ•ŽÂ«:ž™ˆÞ_ä_ˆûË숔rÉ”¾ÄÄÄ..c:´G…=«[$¿‰^yy^•«¨ŒË™ð—®{½’zÊ‹ÌÅvgv‹,'“ +À Öÿgg‘‘‘gsgÍsss‘ssg gs s s B B sssggvgvíÁê ,À˜'z,q~ê~q³zzŠœÃêxÌ>>>Å\–‚ÃFFFY“’_1L÷´T¨ùð‡†ŸˆÄ.-|GµÄ™ãH}žÄè”kðð®°D‹ÑMD¼~ÿs‘ Í‘Íg gg ÅggggggvÅv>Åv>b>gvÅvvÅ?x‚ʳ±½®Ëã:»««ŽŽŽÂ«…ŒÄˆ¤ˆi®‡ý”ˆË›¤Éð”·Ä©ËµH:»…«Ž••^^yy‰ŽTcËû”‡’½‡‡‡½tFê–ÅÅ>ÌÓÊF³0 wÁÅÅíÅÅÌÅÌÅ sgs ‘‘Í‘sg sÍ‘Ís s P¯s‘ggggvÌ\ÁÓ‚œ³±¼št±³qqÀF“'˜Àœ‚‹?v>>v–‹qÊF,ÀF¼‡¤©ìµ´|´(@Ÿ¼“†Ö·Ä©H-GHĤɈn˞˙ˆ¾·É°½Õ¦Ñ,˜ Ísss s g gggggg>gvvvÅvvb>gvÅÑÁ]Mqõ¼²®·Æ.-¨T«=«=…¨.™¡”¾·ð_Öɡޙľ””É”ˆÞÄìHH¨G»«[Ž•^‰yy^¿Â¨ž©ˆrç“ç½®ð°V“Ê‚ÁÑÌÌxÃ,À,0qÃxíÑÁ–Á‹Á‹ÁÌÅ‘sBss‘‘ sgÍgsÍs sB B ‘‘ggggÑÌÁÓqÊF"t*½² t±ŠF³˜˜˜˜Š³qM‹?ÑvÅ?¦~ÊqÊáYŠ’ÖèÄL}|´J;{V¼Š“’ð·›.}.¤‡4½®›©››è®½œ–ÁõtFmf‘gÍs s‘Íg‘ggggg>gvÅ>Å>Åvgg>gvÅvÑÁ]Ãq³¼’{”ÞìHT…«……:cľ”ð®‡{{®É····¾èÞÄì.µŒ¨…«Â••¿‰‰XŽH.Ä{¼ “’ð··®½“,¢‹¦?ÁÃÊÊqÊqÓê‹‚MqÃÊÃà ÁÅ‘¯sss‘‘g ‘‘ s s sssPs‘gÅÅvÅmxêÃʳŠ“½½‡u½ †D“z"±U“zF Ê~x–???‹¸ÃqqŠ¼‡™©Œ´×´Ë(É{½¼ŠŠ†{É›ËÆɼÀÀ4{k·¤·”®{†ÀæM'D,‘‘s s Í‘sggggggg>ÅvvvvÅÑÅvÅg>ÅÑÑ–xêw,zD½{ðĵH
´T»:Œù©èÜðÉðð‡o½Ö®ðÉÉðÉ®¾1ÞÄ˵H¨¨»««ÂŽŽ•ÂT}.©Ä¡{¼ÀŠ’®¾®½±œ‚‹‹Ó~wqÊÂÃw~wÊ,,œFFF,‹Ì‘‘ ss‘ g ‘ ‘s P ‘‘gÅÅÌÌ?x~Ãá³'Š’²°²‡²†±U˜"±˜“³³Ã~ÓÓÁx‹Ó~qÊqõ¼½Ü¾ù-…}.Þ¾É{‡†ŠÀ“’°®®ð®¼3O †‡®®®{½‡¼qà q'Ãg‘gò‘‘s‘ g‘g‘gggg>ÅvÌÑ?m?–ÌÌívÌÑ–]Á‚Ãœz¼’‡®¾ˆÄËHH}HžËˆ¾Ér{{{{‡½’‡{®®®@½½‡²{{® ·ÞÆË.H}¨»»……«»ËÞ¾··®’¼“’®KÄÞ¾r½¼FqqqÊÊwø~¸Ãwq³õz'˜˜'zÁ‘‘s‘Åg ÅÅ ‘ss‘‘‘gÅÅÑÑxêÃwœ³'±†’‡‡{{{‡V½’±¼±U±“FYÊÊw~‹Ó~~‚wq³œ˜½{™JŒT…GHÞ¾”É{‡t“³Àt½²†š®{“37¢Š½o‡o‡’‡“‚qFD³~gÅͯ‘Í sÍgsggg>gvÅvÑÅ]x‹ÓêÓ¦–Ñ–ÁxêMqœ¼’‡{”Þ›ÄìËÄÞè¤É—{{{‡‡½’†’‡@r{‡’““ŠŠ˜† ‡{ð”Þž.Œ¨¨¨»c.Ĥ𗮮ð{½†’®·.žÄÞ{’¼FœáÊqÃÓ‹MqÒœõz'˜'z't*³‘sg gÅ gb‘gsÍ‘‘gÅÅÅÌÌ~wq,³˜’‡{{®®®‡‡½½š±U±±"zFqÊ~~Ó~Ãw‚Ãœõzt‡ð¾(cT»¨.ˆ”ÉÉ®®½¼zÀ˜˜±zÀ±‡{½Š “½‡®®{½’“œqF'D,–s‘ò‘s‘‘‘g‘ggg>ÿvíxÓ‚~‚qÂÂ~‹‹ê‹‚Êqœ³“t½‡®ð····¾Üð®{‡‡½½EV½V’†’@{†Š qq,Y"“ ½ˆÆË..HËÄɇ½‡ðð·ð‡®.µËÞ¾ð½t“z³,œ~ê~‚ÊœFz'z“¼D’’š¼ +ÃgggÅÌÌÅgg ÅgggÅv?]Ówœ±t†’½{ððÉðr‡V’†ttD¼'zFœ~‹Á–Áê~qʳz˜²_·™c¨«:ˈ”ð®ð®u†˜Š˜˜Šqq³’u½±†u®®ð®‡½†“³ Fz'~Ìfg sÍ‘Í s g‘gg>ÅvÅ??êMÊÒ,œ,œœÊqw‚wÊq,³“†’½‡Ö®rðÉ®r{‡‡‡½’š† ’*†t† ‡{{‡‡†"³ qâÊÊ +“U†½Ö®”k¾·kðr½’½{·››·ðð¾Þ;Hµ.ì›{²D˜³~wÊœ'±tD±z'“±uV½*",ÁÌgf>g>vÅvÅÅggÅÅÅÌÑ–Ó‚á³'t ²‡®Éð”ðr‡½’†D¼˜˜'˜'³,q‹‹mÁÁ‹~qŠ'9u™Œ=TŒÞ”ðÉð®É{’¼˜Š˜œ‚m‚"²’U‡®ððd{u†t˜F³˜FœÁ‘ss‘ s ‘‘g‘gÅgªÅÅ\Áx‹wóFzz“““Š³Fœœ³³zŠz“¼¼†’½½½½½½š’’†¼t¼D¼DD±U±¼D†’V{®®{½½½""Y 03030ÀY“¼ ½‡{Ö{{Ÿ½Ÿ®ˆ.Þˆ¾(.:-µË‡’t¼z qq³“*‡½½¼¼¼“†½{{°t“ÊêÌÅggggvÅvgggÅg>ªÑm]‹q³zt’u{ð·¾·”ð‡Ÿ¼'ÀF,³F,œÊÃq~¦‹ê7¢,“±‡ð™Ë¨…cË·É®ðÉð¾ð‡’“˜³‚<‹Àt±½C{‡½†±¼˜Šz“,~Å gÍss ‘Íg‘gggÅÅÑÁ‹¸Ãqáz˜±U±¼±±D˜'˜"˜'“D“˜¼¼±¼±†t¼¼““˜“zŠ“'D“D††† ½‡®ðà››úðC{V’¼U““"¼ Ÿ‡‡Ö{{.âGHËÞ(©HŒ-Gâµ{‡ t"³0 †°K𮽆¼½{rd®°*˜,qm̬gÅÑÅv‘ÅÅÅÅÑm?Ó‚wʳDš‡{𡈛ˆ¾‡Š Ê‚ê‹‹‚~~qÃÊqâqÊŠt½ìØ…T
ÞˆðÖ_ðˆ¾ðr²†˜Š³~êq"“"“ ½Vt†±“±zzF‚Á‘‘s sÍÍs‘ gsgªv\–Á‹wÊ,³˜˜¼††’’’½*’’††t¼˜˜“˜˜˜z"˜Šzz³³œœF³F"˜D±tš’’½‡ð·›ØâG--ãľr{‡½½‡{Ö{®Ö®ÉˆÞ-QT:cÄ.Œ-»|}Ĥr{‡’¼Y “‡·›Ä”rÖÖ‡ð··{½š +œþ¦mÁmÌ–Á¦Áê~q‚Mqq³Š†½ð1ÞÆÞ¾ð‡†³Ê¦–ívvÌm‹‚q YŠÀ +Š†V®Æ.---.ˆk®{{_”¡ˆ¾¾®½¼˜³q¢Ft†U“‡½’¼±“˜zz³,‚xÅ ÍsÍsÍs ‘ggÅÌ?mÁÓÃ,œÕ˜D±’š½‡½½‡u‡u½²Vt†“˜zÀ³À³,Àœ,qq3qÊqq,³z˜D±t ’½‡‡rðˆÆHØQ¹!l¥l!Q×-÷Ä›·””ððr®r·ÄËQ«Q=JË©J.Œ€¹.Ĉˆ {AÀU‡®ÄãØžÞkÖ{@ð···Ú®E±'ÀFq~Ã~q~wqqœœœz“t‡_¤›ÄûÞÉ{†Yq¦Ñÿg¬ÅÑêÃœFz'““†’{ð¾ûËžË(kÖ‡‡½‡®i·ˆˆˆ¾{šUz,œU’“"®@{ †D˜˜'³œ~¦Å¬‘ssòs ‘Í‘gÅÌÁÓ~qÊ,z'±½²½‡{{Ö‡{{°®{®{u½š˜z³œqqÊÊq‚‹êêê~~ÊÊFFz±±†’½½‡Ö{É”™ãµ»¹Ž¥‰é¥é¥l!|GH.Þ¤¤ˆ™Ëc¨[ŽG:.cHc´«€Û€|-µHHãÆ”¼“4rÞHGG.Ä”rÖÖÉ·ˆ›Þ·”®{½½¼' +FœÊœ³F³³³z“to{1ÆËÆÞÖ†Àæ–\vÑx‹qF±’½‡‡{r𔾈޾ÉÖ‡Ÿ’’ou®i¾¤ÞÞˆˆ·®²†z³Št ± +"{@š†±“˜zzqÓª>Ísò¯‘ ‘Í ÅÑÁÓ¸ÃÊá³'šE²{Ö{ýÖ°{®ð®@®®u ±ŠFqqêq ‚‹¦¦m–¦¦Áê‚Ê,,z'±’š½‡Ö{rð”Ë÷Œ¨«ŽÛ••¿é¥lÛQöØ÷ËÄ›ˆÞÞÄ.«[Ž!:cH¨ÂŽlŽ»G×GâÄ4U4’É™H|.ˆ®Ÿ½ÖÖrðÉ··@ðd@@°V±'zÕzzz³Àz“¼’1ÞLÄ”{*Šqêxm??Ów³uC›+ÆÆ›+ˆ¾ˆ”444†’uð_·1™ÞèÞÞˆ¾®† + +'*D,w~Š’{{‡††±±zwÁíg‘s‘s sÍ‘‘gvÑx]‹qÃq,À˜“±’’‡‡‡°d®dd_{{®®_ð®{½z,Ã~~‹‹Á–ÑvÑÑÑxxM~Ã3,³¼t½‡{®””k”¤ˆ©.¨¨…«ÂÂÂÂ[«[€……|…|…¨Œc;©©©ì}G|•¿Ž«»ŒŒ¨»«Ž¿¿ŽŽŽ••¿•Â¾’4’‡”©¹¥Ž»ˆ’“˜D'VE½²{°{dððÖ‡’““'˜˜D¼††’‡É¾ÞÄ©ˆ¾®’“, êÁÁ~3¼‡Éˆ;¨:Œcž¡_{h†’’½‡{É·ˆÄÄÄž(Äěޒ˜Š˜'z~m?¢'’V’±¼Õ³‚mÿss sBsssg‘>v?xÓM~Ãœ,z'¼’½‡{®ð__®r{_ð_ð𰇱 +Ê~~ÓÁÁ?ÌvvvÑ?x‹M‚ÃÊ,À'±*‡{ðÞ1ÞèˆÞÄ쌴…«Â«««»¨¨»:¨-»¹=…»:cìËžH¿¥XŽ=…»……ÂŽ‰¿¿••‰^^y¿[cˆ”Ÿä®L´léŽLÖ˜œ,qYFz +“"¼†t²{‡@ÖŸ’¼¼±±¼±††’‡rèÆÞèðÖ†"ÀÃ~~~qY"’{¤ÞJŒT»´¨c;›1ð‡o{{ˆÆËËJ.;Ëìˡ“zx>gÁqUt¼¼˜œwÓ\Åssssss s‘gÅÌ?x]~ÃÊœ0Š'¼’½{{®ððiÉ_r—®ði®½D³Ê~‹ÓÌ–ÑÅvvvÑ?]x~~qÊ F“ ‡®ˆn.ž..ìÄÄĵŒ´«Q…T¨J©ÄìËžÂÂŽ[«»µ.µ´[•‰‰¿•Ž[•‰‰‰¿^yÔÇp)º!G.¾ðÖÖÜ™€È Q¤˜¢‹‚~~ þqqqœY±’½‡Ö@V’’t†±†††½‡rð¾è·¾®½†ŠFÊÃÃÃáz±’{¾Äµ»|«|-ŒìË™·k·¡èÆì.H
´J...H®z³Ê–ª>mʱ“ +³œq]–ªgg‘ss ¯s‘g‘ÑÑxx~MqÊ ,z"¼ŸÖ®Éð”¾ðÜ®ðÜ®½' ËÁÁvÅÅv>>ÑÑxxMwÃqFzU²®›Ëã-}.Ë©Þ;.Œ-»´
žèk”kÞì.}|[Ž•«}µHŒ-«¿ ‰ ¿ŽŽŽ•¿‰^‰^º)ppæ„Sº!GHÆ”ðÜèµ€ºƒlļqê~~ê7‹7qþqÀ¼†ÖÖ{‡½š*’š ’½Ö{—ð”·É{’“ +³ÊÃÊÒ,³U’®ˆì:|[Ž€Â«´â}÷žžL.÷}â-´TGTG=ŒHùH”’“F³Ã]vÅ–Ê'zq~]?\vg>gss ssss‘gÅÅ??‹MÃÃʳ +˜U’V‡rrÉ”¾¤ˆ¾¤¾ÉÉÉð”®½˜Ê~êxÌvÅ>>vvÑ]x¸‚Ãq, Y“‡@ˆ.G´-HËÞˆ¾ˆÄ.HH.ˈ”r‡‡Ö·™.»QÂ$•Ž€µ¨…•‰ººº‰¿•¿‰^º‰^ÈyÇp2ææRlQG숤޵|‰ºl.š3ÃÊqÊ ‚qq‚qqz¼†ŸÖ@‡‡²²²’²½½‡{Ö®®_®½†˜³,qwÊq³˜t½ð™ž´«lŽ•Ž!««……»…||=¹ÂQ«=…€TcH..·²¼F³Ãmv>¦Êz3~¦íÑív>gggg‘sssÍsg‘>gvÑmÁ‹Ãq,³'U’V‡Éð¾¾ÞÞÞ¾”ðkð®’ +q~Á?ÅvÅvÅ>Ì?x¸MÊqÊœYzU’·Ä}´GHËèÜÉ”èÄËÄ™¾ÉÖŸŸ‡”è˵»[•¿Xl€|-Œ¨T«•¿ºRȺ ‰‰^‰^‰ºyÈÇ2æ2æR¥¹G.©©}…¿ºlË’ ʳFœ3Ã3qÃœŠ½Ö{‡‡½V²½²½‡‡Ö®{Ö®{½š¼FœÊÃÃqF˜š{·ì«Û•¿l¿•ŽŽ•!ŽÛÛl•l$•$ÛŽŽTc.H㈇UzFqÁѪMáFæÌÅ\v>v>vg gÍsssssgvÅÅÌÁÁ~Ã,F˜D†V{@rˆÞÞÞÞ¾¾”Éð‡’Fq~ÁÑÅvg¬>\v¦Ó~qÊœ,ÀYŠ½rKÄ.HG´-Hž›¾®{‡Ö®”ˆˆ¾r‡½½½{®è©.Œ…$¿Xé¹´:»Ž$‰^ºyyÈ^º^‰^^y)Ôp22)R‰$[…»-cù¨«X‰QÞt Ê'˜F,qqqq³“†½Ör®‡V²²š½‡{{®{Ö‡‡²†±Fœq‚wÃœÀ¼½Ü›}´Â•¿•¿¿¿•¿¿¿‰¿‰‰¿‰¿‰¿¿X¿¿•:cžH.›½¼zzá~Ñ~áz,qÁѪv\v>vvÅÅgg‘sssg>g>Å–ÁӸʜUt‡r𾈈ÞÞÞˆ¾”É®‡†F3M¦Ì>ÅvÅ>gÑxq,œY³“½@·Ä˵|--µËÞiÖÖVŸ‡r”É®½½½½‡d¤Þ;H»[¥•ºlÂQ…¨:»ÂŽ¿ ^ºÈº^º^^ÈÔpp2pº‰XÛ[Q»Œ|Ž¿¿è¼ ,³DDzFq~‚q³˜’‡r@É{’’’²½u{{{Ö{‡‡‡t“˜œqÃqMqó“’{1.»€••¿¿$¿¿X‰‰‰ ^^‰ ¿‰¿ ¿¿¿¿¿c.H.ˆ{†FÀFq‹íw'q‹íg\vvvÑvbÅÌÅgss‘‘ggg‘vÑxÓ~³˜š{®ð¾”·¾·ð®’¼FqË?vgÿvÅÑ–‹~q,³z +Š +¼ ÖˆËcTHµËˆð‡’ ’ ‡rð”®Ö‡Ÿ{ðèèÄù¨=Ž$é6¥Ž=»»T…[Ž¿‰R^º^‰‰‰^^ÈyÔ)R¿•$ŽÂ=…T…Â$ŽÉ˜3F±DzFq‚wqzU½{ð¾ðÖ²’t*’u{{{‡Et'z,Âw‚‹‚œAÖ¾ù-«[ŽŽ••¿¿^¿^¿^‰‰^^^^‰‰‰ºº‰¿•…
;˵.{† +zFœ~ÁMz'q‹mÅ\>vÅÑÌ–ÌÌÅ‘‘sfgggggg¬vÑÑÁ‹qÊ YŠ†’‡rÉ@ÉðÉÖ‡t“FqÃÓ–vg>gÅÌ]~w,œFF³FÀFŠ‡@ˆÄ.¨-c.™ÉýV†’’{#Éð®®®›Æì;.c¨=Â¥‰ ¥Â»T»«Â•¿‰‰‰‰‰‰‰‰^Èyyy‰‰X¿Ž[Â……=•Â}rŠq³D˜,qêqœ˜š‡ð”¾ ®’ ±t½u{{{{‡½’±FœÊ]Áê‹êÊŸÖ¤.¨Â•ŽŽŽŽ$¿X¿¿‰ ‰‰‰‰‰‰‰‰‰¿•TµÄ..è{’ŠŠzFq‚‹wFD¼' q–í>>ÑÌÌxÓÁ‹ÁÅsgggg‘‘‘>>Å>ÅvÑ\–‹]ÃœY˜’‡{‡½U˜œÊÊqx–ÅgÅÌ–Á~ÃÃÊ,qÃÃqŠ’®¾Ä.H:}HµËˆ{½½’’‡ÖÉɾ”¾¾èûžccùc»ÛXéé$»T»T«•¿¿ ‰‰^¿‰^yÈÔy)y^‰‰¿¿••[Â…«Â«.Ö³œF'±',q~‚qá¼²® ·¾ðÖ†±¼±šV‡‡V’*U'³Ê¸‹?íÁê‚À’#(HT…=«[ŽÂ«=ÂŽ••$¿¿¿¿¿^¿¿‰‰‰¿¿»ù©ì.ˆ®’DŠ'ŠœÊMMœ±±'œ~>>gÅÌÁÓÃ,Ágggg g ‘>>vvvíÑ?ÁÓ‚~qÊœ³YŠ“’’’’˜Š,œ,Ê~ÓÌÅÅÅÌÌ–Á‹Á‹‹Ám––7,†ÞËù-
µ.Ë›k®{‡‡Öð”¾èˆ©HQ€!€Q»
cŒ»Û‰6‰Ž=…¨……«Ž•••¿•¿¿‰‰^ºyy^^‰‰ ‰‰X••Ž=…[Â…ì½ÀqFz'Fq‚‹qz†uð·¾¾®‡†¼˜˜¼š’’†¼“³œÃêxÁ\Ìm³ d(.:´T…»:¨T»…=Â[ÂŽŽ••$¿¿¿‰¿¿•€.ìÄ..ÞðŸU““ +YÀÊqà Š¼’’˜wmggggÑ?‚FYÁ‘ggs‘s ‘ggÅÅÌÌ]MÃœ,œ³F³'±¼D±U±zF³,œMÁÅÅ gg‘ÅÅÅÅÌÅÅÅÅÅ–q"u”Ä.}
HžËÞð®®{r”¾èèèˆ;µ…Û¿ºƒÈ‰$«:Œclé •«T…«Â••••¿¿¿‰^ºyÈ^‰‰^‰^‰¿¿•««Â€hœqFõFqÃêê‚œzšCð#{’¼˜'¼±¼¼"ŠF‹ÁÑí>ÅmʽÄH:GT}ìùJcc
:¨««[Ž•••¿¿¿¿Ž«
ž™.žÆ¾{’¼U“˜'z,qqY¼½u²óœÁgøvÓœ +FÁ‘g‘s ss‘gg>gvÁxqq,q,q0œ +zUt’t“³,wÁÑ‘ ‘Í‘g‘ggggÅm~z½ðˆ©.Œµ.ìÞ1¾_ð·1ÄìË쌅Ž‰ƒ)pSpÈ¿«
cHŒ€•¿Â………««ÂŽŽŽŽ••¿¿‰‰^‰^‰‰¿^‰‰¿¿¿Ž««[Ž…©’qqáqÊ‚ ê ‚,±u®ðÉÖ‡’†“zz“±"“À qê̪>>ÿ–Ç ËØ:
HìÄ©Þèˆèˆˆ(Þ;c
¨T«[Ž•¿¿••Ž|}ù©ÄžH˛Ɇ†U¼¼D˜YÀÀŠ¼†½°Cš,¦Å‘î>ÁwYÊ <ÍÍÍÍs ‘‘‘‘‘gÅÿÑ–¦Óê‹‚Á‹ê~qœ'±D˜FœÊ~?gs sÍÍs g‘gÅggvÌ?¸²ðÄ.cHËÄ¡·™ÆµHŒ}¨»«Ž‰º)ÇS)))yX«¨cµ}GÂ$Ž«=…=«ÂÂŽŽŽŽ•¿¿¿‰‰‰‰‰^^¿^¿¿••[«=ÂÛQ›£qq‹‹¦¦7‚z±½°®‡Ÿ ¼¼“zz“˜ŠŠF0Êê–ÌÑÑ~á¼dHH..ÄÞÞ·Ü𮽽½‡{®É·™ËùcT…[ÂŽ••ŽÂ|
žË©.}ËƾŸ¼¼±D±“““Š"t‡Úd±~Ìg¬vmÃÊ¢ssf¯òsssÍss‘gÅgªvªÅªÌí–ÌÌí–ê¢z³œ,‚–>‘ s ss sggÅ >gÅÑmØE®·Ä.Œ}HLÞnˆn›µG|…ÂŽ•‰^ÈÔ)RRR)py$«Hù}Q•Â«««……«ÂÂÂÂŽ•¿¿‰¿‰‰‰^¿^¿¿^¿•ŽÂ««[Ž|Þ¼‚‚‚ÓÁ–ÁÁêqŠtV°{V4U¼““ +³z +˜“ŠŠŠ³wÃw,Õ*+ãHH.aˆ””É®Ÿh“ñ 33Š¼’or¾èJŒ«[ÂŽ•ŽÂ«:ŒJì.HË›{½†††††’’’4†’½{®†þ‘øvÁÒ,‹g¯ss‘g‘gsg‘ggg‘ggÿgªv\\?ÌÁÁÌ> Å,FÃxÑvÅggÅÅggvÅÅÑ–xþœ“½ðˆÄËHµ
žìÄ©žŒG«Ž•¿¿‰^ºÈÈȉŽÛXR^$…J™cG«[=«==«[ÂÂÂŽŽŽ••¿¿¿¿^¿‰‰^¿¿¿¿•Â…¹Âl·“~‹Ó?mm7êÊ'†˜'³Fz˜ +z +˜D˜U¼““jhŸ—èìJH.ËÞðð°²²±Fqêê¦ê¢œÀ“†½{ð”©c
»«[ŽŽŽ«…:cžìHµµËÞð{u½½ŸVŸ‡‡½½dðu +êíÑêÃÁÅ‘ÍÍsgsg‘gggÅgÅÅÅÑí–]M,F,`ÓÓ DDw?\îÅÅÅggg>gÌ–x‹Ã À†‡ð·Äãµ}ž.;Äž»€Ž¥¿‰^ºÈºÈ^‰Ž|TŒ:«•¿RŽ:;cT………=««[ÂÂŽ••¿¿¿¿¿¿¿^‰¿‰^¿•Ž«…¹[lG·Š‹‹x–x‹ê‚qœ' +ŠY³œáœõ³z"˜˜'±D¼†’’‡r¤ˆìcµ.©¾É‡½“,q]\Ì\Áê3³“¼†’½or·Äž:»«=«»ŒcJìJc}÷Ë›”ðÖ{Ö{Ö{Ö{®®{®®ð·½À‹¦‹~‹‘sg‘gÅÅÌ––Á7–7m¦‹êqœ³†ŸC®Et +‚Ì\¬Ì–ÁÁ–ÌÌÌÌ–Ó~qFÕD“±’‡ð¾ÆËŒHcžìì
»€$‰‰ºº‰ÈyÔº‰Ž…Œì5™
[º ÂH;Ë.}…«=««ÂÂŽŽ••••^¿‰‰‰‰^¿¿¿•Ž«…=Û$GðY‹ÁÓxê~qqY³F,¢~Ãwqáq,³Š"±¼tt†½‡{É”™ÄžHžÄ”Ö½’¼zq¦Ìíªmêqz'† u’š½½‡r”Þù:T…«=…¨HcžùH}--}HË›¾·ðrr{Ö®rð”ðð··¼‚‹q‹ÅsÅ‘– ~ÊÊ0, ,,3Ê3,œ³'tôr+›² *¼,‚íÑ\–‹ÃÃ~‹Ó‹‹ÃqFÝDt*’š‡{r·Ä˵}µ.ùHŒG[¥‰‰‰‰‰Ô)Ⱥ¿Â»}(¤Ü5HŽ •Tž©H:´T´……=…=ÂÂŽ••••¿¿^‰^‰^¿^•ŽÂ«…¹•¥:® ÁÁÓ‹qœz³ÊÁÁ¦‹êMwÊqœ +˜¼*½{@·ˆnÄž.ìÞ”‡4“ +Šq mí¦êá˜*²‡u°®{{‡½½‡—¾Ä.ŒG»…GŒcžìžc:-}.ìÄ™¾¤”k””¾·ˆ¾··®’z,q, <g‘ÌÁÃœ'’*†’†††’²‡Þ©Ëìð{‡½†z¢¦í\\xÁwÃM~ÃœÊ,z'±šEuu{{®ÞË}
}Hcµµ
|Ž¿¿¿¿¿‰y)yÈ¿Ž…´.è¾&Ö5HŽl¤}-:´T»T»T……«ÂŽŽŽ•¿¿¿¿^¿^¿¿¿ŽÂ«…[Ž¥-{3ÁÁMw,³˜˜œ~xÁÁxÓÓq¸, Š“†½dð··¾ˆ¡ˆ›ˆ{’ŠY ¢q¢‚¦‹qF±š²²E½‡d°{‡½‡Ör¾Äž´G¨.;;Jµ
}:»GG¨-cHË©Þˆèˆ1ˆˆ¾›Þ{˜ +˜q Å ÁÃ,D²E‡{{{@®ðÆŒ
}Ƈ½²†Š¦–í\\Ì?ÁM~wqáq,³DtVuC®°®{rÞ˵cµHµH´=ŽX••¿‰^)ÇÔº‰Ž«…-µk—ˆ»‰Q;ˆ©.
::¨Œ
¨:»…•$¿¿¿^¿^^¿•Ž[…«XŒ3Á‹ÃzÕ±±qÓ–Á–––]‹]~q,Š¼²{·ˆˆ·¾·¾¤{½Š þ q Ê qœ˜ttt*t¼±†tVu{ŸVŸ‡É¾Äc¨-µììÄ©žc}ŒT´»……»»}HžìÄ™ÞèÞ©Þ™›Þ¡r²†*V"–gÌÁ~,zÝš*u{d®®ð·¾›Æã÷»¨è½“z“'qÁªíÑ\\v\mx‚wÃq,œz“±’{{®®®®ð¾ÞËHcµcµŒ
»=Ž•ŽŽ¿¿yÇpÈ¿•Â…GG´HkkJ¹¥Ž-ì©ÄcH
µHù.cJcŒ:»=••¿¿^‰^¿¿¿•Â…[Žl.½OÁ‹wʘt±á‚??Ì–Ñ??x‹~qÀ“’{ð·¡·”ð_®®{†³~¦mêÊŠ˜“'±Dt±D˜zÀÀÀ± u’V’‡ÞËH.J;©Ä;.c¨¨…=«=«Q…´-µËìË™ÆËÆ©ˆr{E‡°¦sgÌÁ~,á,Š'¼*½‡@Éð”èž÷ccÄ—Š77¢,7PÅv\v‹¸ÃqÃœœYzUtE‡d@®®É·™ËHHcµµcH}Ž•‰Èp)‰•Â´-|Q-žÄ5”5:l|ŒË©.ùHcžJìËììJŒ:…=•¿¿¿^¿^^¿•Â««Â!Ë’Á‹Ãázót±,]–ÑÌÅÑÌ?xêÓ¢,¼½®···”®{Ö‡‡½’ÀqªÌ‹F¼††±˜˜'±z³ q3ÃþÊÀ*½‡VŸ ŸrˆÄžµ.ìÄ©©ËùµcT´«=Ž•Û[¹«»H©Ë©.µÄˆèÉ°{ 'gggÌ‹‹‹¸Ã¸ÊœFz¼t’½Ö®É”ˆˆÞ©Ëˆð†qÌgÑÁÁvgÑÓxvv\‹¸Ãwqq,œz“¼†’½®®ðð¾Þ˵H
Hcµ¨Â««•¿^Ç)º¿|ì.H-´GŒÄ5ˆù|$ÛGùìJ.ž.ËÞ舔¤ˆÄÄ.
¨«Â$¿‰‰^‰^¿¿Â=Ž!ì¼7–‹,'ttzwÁv>Å>ÑÑ?Á‹þÀ¼‡®¡®‡’¼¼¼D˜FÊÁŪ‹³Î½²½¼˜z˜z³,3‚þ7‹qYtV‡VŸV‡ÉˆËË..Ë©™Ä©ìËùŒ¨T…«Â[ŽÛ[€Â´}.ìÄžHË™”{½@d +ÌggÅ–Ó‹]~~‹qÃœFŠU’’{ÖðÉ·¤¾ˆÉ‡“~ªgªÁ–Ìv?wüïx]wqM‚ÊqœŠD¼t’’{®@”·ÞÄcHµcHµ:…=«=«Ž^^)y¿Â-;ˆ™ûË-´-µ™|$Û…µžù.JžÄè¾kðÉ”¤ˆ©.c¨T«Ž••‰‰^‰¿^……[|ˆ¼ –Á~³ÝD³qÅvvÅÑÑÑ?êM3 +’‡ð®½¼ŠÀ À³0q~mÅÑêÕ*²Vš†±'Š'˜“zÀœ‚þ‹~ '’ŸV’‡r¾›ËLË™›ˆèÞÄ©ÄùHµ»…«€[ÂQ=Œ.ì.µËÄÞ”u½E½ÊªgÅ–‹~Ó‹‹]‹ê~qœY˜¼ ‡{ÖðÜð”_r0Áv>v?ÌÓÁÓ‚qÂÃq,Š±†’*½{®ð”ÞËHcHc}Œ-¨«……«•^yÈ¿[ˤðɾˆËG:¨Hùù¨€Ž¹:µJµ.ËÞ¾ðr®®É”¾ÞËc:…=Ž•¿‰‰‰‰¿Ž……Øðz7??ÁÓ,³z³‹ÌvvÅÑvÌÑ?Áê0¼½rð𰚊œ~ê‹‹~‹M‹?ÌmÃ'š²½*¼˜Š˜“D¼'“³ Ê¢‚ qÀ‡Ö‡‡‡Éèěވ·k”¾èˆ™Ë©Jµc¨G»=…|«|¨ùË˵ËÄ©”½t“~ªÅgÁM~‹x¦Á¦xê~ʳ“¼ Ÿ‡{r®Ü®r’"qxÅvÑÁ?%wáá`]Ó‚wʸ~‚q,“t š††’‡®·ˆÞÄ.HŒHŒ¨G…|»T«•^y‰ŽJ¤rÖ{¤ËH}--Œ
µ:«ŽŽ|¨cµË™”_r{Ö®r”ˆÄžH¨…«Â•¿¿¿¿•Â¨:L{ êÁ––x‚ʳœ‚ívvÅÅvvÑ?ê~Š†‡®ð{’˜3ê7íÌmxÁÁ–ÌÑ‹±*Vš†± +˜"±†t†±UzÀ, qqÀ†ðÉrÖÖðˆ›™ÉððÉ·¾¾™Þ©ËžH}:T-:žËËžH.ËÆÉtŠzF¦gÅÅx~M~¦Á¦Á]‹qÊœ¼½V{®®®®®½ÊxÑ?‹x–‹ÊFáw~‹~Ãq~ÃÃq0˜š½ š†½®”ˆÄËcHcŒ:´´G»»«¿^º‰«c讇o{ɈÄ.
Œ:¨¨»«Â«»-:.›ð®{{{{Öð¾ËžH
»…«ÂŽ•Â»-c›oq‚Ó?ÑÌÁ‚qœ~ÌvÅvÅ\ÑmÓq,¼ ®@{u±œ‹xÌvvÌ????Ìm‚,˜tš†D““Š±¼š š†t“˜ +À0À†{É·¾Érܾnˆ·Éð{®rðk¾¾¾™Þ©ËìcJµùž©Ë.ž.Þr“ ,¢–ÿÅ>Á‚ÃMê‹Óê‹ÓwÊ,³"±’½‡{®{{‡VUFÃxÑ?xÓZÁ~,FF‚Ó¦M~‚~qóDš½E’ ’½@”·ˆÄË.}
}:}¨G»G»»¿^¿•T©ÉŸ’½‡”ˆÄ.Hµ:-…«……………|-žÄ¤ð®{{Ö{®r”¾èÞÄžc}¨…«««»GcÄ_“ÃqÊÓ–vmm œœê–?íÌ?¦Ów³’‡@®‡†³q?ívg>vÑ?–?–?~œ'±±¼˜"zU¼t’’²V’*’±“˜"†”Þ·””¡¾·kð®Ö{{®®®Üðk¤¾èˆÞ™(Þ(èÞ(Ë.-H.ˆ‡³¢q‚ÌÅíÅ?ÓÃqÃÃq~wqÊœF˜D†*½‡‡½½’¼ +q~?Ñ?Ó‹‹ÁÀŠz ËÁÁê‹~~3,¼* ’*’’‡{ð¾ÞÄ.cŒ-Œ:¨T¹Ž‰¿•…ckŸ’’²dˆÞË.cc
¨ŽŽ¨»»…€=GÆ·_®{®{r@”W¾è™Ä잌}…«|…¨Ëè²³qzÝá‹?ÌíêÀ'³ÃÃ]‹]MqF˜‡{†'Ãmvv>>>vÑxÑ–Á‚,Š±“D““˜““D† š½u‡°‡E½’½®·ÞË©›èˆ¤¡”ðð{{‡Ö{Ö{Ö_rðÜðkkk¾ˆèÄ.-H.ˆ’œþ‚ê–ªÌvmMÊÊÊq,qÊááõz¼D’’²½²’t¼" ÃÁ?Ì?x~ÁÁq¼ +³Ã‹mÁÁ‹ê~ʳ"t’E’*½‡r·ˆË.H
:Œ:¨-´´«•‰$ÂŒ™Ö4†’{ÞËHHJ.ù
«•«ŒŒ»…[€G}¤ðd®ð@ðð#¾i¾èÞ©.µ¨»|««Q¨Ä9À³tÏDwÁíÌ‚“EtÕFá³õ³ÕtE°®’"3¦ªv>vvvv?–?Ñ–~³zU˜“±"“'“¼††šV‡C®d®®®{{ðˆ.ãËÄnˆ·¤·É®®‡‡½‡½‡‡‡{{{®®®_”5¤cc»Œµ÷1’ËÁÁÑv>ª?ÁqœFFFŠŠzz˜˜¼¼4 ššßt'“FÃÁíÌÑ–Óê‹‚Š¼†“ËÁÁÁxx~óš½V{{ð·ˆÞì.žH
}-Œ»=Ž$¿…Äð††’oÉÞ.Hcccù¹!ÛQ-ìc-€¹´H™¾_r—®rðɾ¤(©JcT=[!!H·‡ÀŠtudEœxÿm,tV²V’444’Ÿ®dšDœ¸m\gÅ>ÅvvÑv–Ñm¦qFz˜"""˜““±“t†½½‡{@®·”É”¾Ëccµ.žÄ™©·_®Ö{Ÿ‡½½½½½½u½u‡{®”茌»¨÷µ¡±‚‹?mѪÅÑ–x~Ã,,³“'˜ó±±4†ttó˜ +FÊê–vÅv–Ó‹‹~œz†’†F3 Á?ÁxxMw,t u{ðð··è›ÄËc}-
:¨»«Â•$…
·o¼9‡rˆËH.J.ùJ»¹GùˆÞJµžË™k_Öý‡ä{ý®ð”¾™©.c
»T=Q:ã¾V¼ +“t°šœm¬Áq'š‡‡ÖÖ‡{@ð²'œ‚¦í¬gÅ>ÅvÅÅÑíÑíxó˜"'“'¼D¼±¼¼’’½‡@ð¾··””ˆ©cccHž©ãÄn¾ð_{‡‡½½’’†š ’½‡{Ü©ù¨:»:}ã˜êxÌÌÑv\–\x¦MÃ,¼¼ttšš’’4U±Ý˜õ,q–ÌvÅ>ª?‹]‹‚Ê“†½½†“qêÁÁM~MÃœ†½®·ˆ›ˆ›Þ©ÄµHŒ-¨:T»|=Ž$Â:™®†“†{·ÄHãËÄ;cc-HÖÖ”i·¡ð‡½½‡‡‡{{ð¾·›ÆËËLËˈ#{½¼Š““†’²'wmÅ]~³'tV‡Ör®r®‡*'œ‹mvªgÅÅgvgvÌvÌÑmÁqœ˜'“'“"±¼†’¼t’½‡{rð¾¾1ˆ™.c
-}H}÷ƈr‡‡½½’†’†††½½®ðèÆc:…»:¨Øžñ‹mÌ\Ì\Ìx?ÁÓ‹‚ÃœFŠ'±Ît*4 4¼ÝzõÒ~ÁÅÿg>Å>Ñx‹‹‚Ê“š‡{‡ +Ê‹ê‹ÓÃá³DšÆÆ©›™Þ©.µŒ-¨:´…ÂŽŽ«k’£¼u¾›Ä˛ވ¾c¨T}µˆä“j’½‡{Ÿh†’Ÿ‡‡®É›››1›ÞÞˆ¤”Ö’¼“Š““¼¼¼±±³q]¦¦~q³"¼’’½‡‡‡*Uz‹ívÿÿ¬Åv vÅvÅvÅ\–êÃœ˜"˜"¼t†š½½‡‡‡‡@ð¾·1Þ(Äù
Œ-»G´öØHì¡r{‡‡½½’’š½u{®·Æ˵-»:¨
µË_Àx–ÑÌÑÅ\?êÓ¦Ó‹‹~ÃÀz˜±tš’ ’4Dzáw–¬g>g\>v?]Ó~q˜†{ð@‡šŠq‹]–qq +t‡ÉˆÞËËÄÞ™ÄÄìJ}
¨-»»…=Â[[¨(‡““’›ÆÞˆððk(…
HÄ_¼33A“¼†tU¼’š‡{®@@@ðd{°{½4“¼“AÀÀŠ˜¼††¼"ŠÊq~q~‚Ãq,³Š“U†Uz0~ÁÌÅÿgÅÅÅÅÅÅ>ÅvÅ\̦Mq³Š'“'“D††’’‡{{{®{®É·ˆÞÄ©Ë;.µ
G|´´}÷Ä”_{‡‡½½½½‡®ð¾ÆãØ}:¨:ŒŒ:ž›{³ê?ÌÌ\Ñ?ÓÓ‹Óê‹ê~3,zÝtš /’ ±õw]gg>gvvgv–Ó‹‚ÊŠt{d·@²DœÃ~‚ʘ½r·ÞËãžËLÄÞ©Ëì.c:»T…««Tù4À£{¡›Öš½‡®:«Tc©¾‡A33YŠ˜˜¼†t½u{‡½’U±˜˜ŠÀ0 O33 ÀŠ¼’’Ÿ’’†¼zÀœ,œœÊqÊ FÀ““˜ +³‹ÌÅÅÿÅgªggvg>gvÅvÅÁqÊœz"˜D¼t½½u‡{®®®Éð·èÆ©Ë..c
Œ-»G´G´.Ënˆr{‡‡‡²½uðð·ÞÆ.µØ}¨c
è½ ?m?–Ñí?¦]~¸~~ê~‚Ò³±ÎŸ‡Ÿó,xvggÿ>ÿv>>\?x]~qz½®··°²±±z¼½®¾ÄùH}HìÄ©ÄìJµŒ-»»«=€TùˆŸ““’ð·®½¼z˜†{5-T
ˈð‡tŠ˜''±D˜,Êæ‹7ê þ3 À4’‡o{ÖÖrr†Uz“'zœ,q,³'FÊ‹mÅggggggÅÅgÅ>gvÅ\Á‚ÃqF³z'¼¼š½‡®®_ðÉ”¾ˆˆÞ©ËžJµ
}
»´G-©ˆ·É_{‡{{‡‡{®¾›ÄããžHc:cŒÄ”š3–í?mx–?x]~wÃq~ÃÁ7wáztV‡ÖDÒ\ÿÅgvÅv>vxxx‚À±½{{®@{Cu©.:T-}.ìÄËì˵¨T…«=¹[€»ÄÉ4À¼‡··ð½"Àqz¼‡Þ:Tù(¤ð®ššš'³,³F³,þ~Á̪ªÅí–m7qÀ“½Ö·1_®#ˆ›·{²†ttD˜F Êq,³FœÊqÁÅgÿsÿgggÅÅvgggg>mx~q,œŠ“'t ‡®ièè·¾™ÆËË.µ¨¨-»G¨}}Ë޾ܮ®®{u½²u‡u{®¾Þ©ìËcccËÖ± ]‹Á]–]Á]Á~‚Ãq,œÊ¢ ]wz±½r@‡˜ÓvvÅg\>g\vv?\Áx‚󱆚½’†’†±½{{·Ëã-¹««[TŒcË;.ù¨……[«[¾†ÀA½ð·*“œÃ‚œ¼®ˆ.J˾Ö{®°C*,~‹ÁÁ–ÅgggggggÅÅ< œ +’®”Ë.H÷ìÆ™ÄËÄ®V†D¼±œÃ‚ÃMÃÃÊËmggsfÌgg Å>ÅvÅ–]qÊœF³Š˜¼†‡®·ˆ©.žË.Ë©ÞˆÞ™ÄìHŒ}¨-»GŒË©”—{{‡š’½½½½°ÖÉi›Þ©Ëùˈɽ“œ‹‹]Áx¦xÓêMwqÊFF³Êþ]¸œ˜ðÉVzx\vÅÅÌívvÅvÑÑxx¸ÊŠ±’VŸ4¼ŠŠÀ˜t½®ËŒQ[Ž[|T-Œ.µHc}…ÂÂ[«´.Ü“À“{ðÚ½“q êqz†®(.;(”Öu{°E˜MÁÌvÅÅggggggggÅ̦ʊV®Keã.ãµ÷žã©ÄÆÄÞˆ‡†¼Š˜'zFœÃ‚M‹êw,qË̑gg‘ÅggÅggvÅ–]‹Ãq,œ³“D’{ðÄž}}..ËÆÄì˵¨:»´T¨}HJ©Þ·ð®‡²†tt††½½Ö®¤Þ™Þ™¾”{’˜œÃ‚~êê~‚~qÃqÃœ³"zYÃ]Ów˜‡”@½õ>vÌÌ–ÑÌÅv\vvêx‚Êz†’‡½’“A033Š“’r.»ÂlÂ…-Œ¨}T¹ÂŽ•ŽÂT™½ÀÀ±®ð{Uq¦¦¦z±½ðˆÄÞ¾ð½štD'F~ÌbgggggggÅ–‹Y¼›Þ›ˆ›ÞÞÄÞÞ™·ð’UzFÀ,œÊwqMê‹‹ÃœFzFêÌg‘gg gggg>Å–x~qÊœ³Y³ +Š¼½{¾Þž»|¹´-}HžËìHµ¨:´»|»-¨¨HìÄi®‡’t¼“˜“¼Ÿ‡r¡·¾è”ÉÖ½¼“FqÊqÃqwÃqq,q,¼¼F‚?‚F‡ ½ÒÌvÑ–ÁÑíÅvvgvvÁx‹œ“š{®ÖV†“ÀFÀ +4Ö¾.…•Â=|T´´:|[Ž$¿Â.ð¼3z’ ® 37–êÊ'’{ˆÞ·É{¼À,q‹mb‘s gÅ gÅÅgÌM,’ ·KÖ‡ÖÖ®Ék”¾”É{½¼“Àœ,qÊ‚‚ÓêÁ‹MqõDt*‚Å‘Å ‘ggggÅÑÁ~q,,³F³Y³˜†½ðèË}G¹=€[=¨µ.cHŒ}:»|T|…´T-H¾°ot±z˜““±†½‡{ð_ðkÉɇŸ¼'zF³,œ,qœÊq,œ, zU’E"w]Ó³‡K¾Ã\v?ÁÁÅÅvÿ>vÅvmÁ‚Ft{ðÉÉÉÉ{{’†ŠÀ“¼ÖˆcQŽ$•«|T|«Ž•¿¿Ž«T:Ä{³3˜uð“ í–wz’‡É¾ˆ®²,‚ÁÌÅ‘§‘ͯÍsÍ‘ggÅgÅÁÊÕV{ð@®V½†††’½‡{r𮮇V†U˜"³œÊqÓ‹êÓÁê‹qt°² +¦‘gg‘g ggÅ–‹w,œF³œFÀz“†{”ÄH»…«Â••$•¹GŒHµH}¨G»|……«€«G}Æ¡‡’±ŠzŠ˜“¼ ŸŸ{{{{{_ÖÖŸ’†¼±'z +z³FF³F³,ÀFÀ'’œx]³ †]ÑÑ?––Åÿgg>g\Å?Áq½·¾ÞÆÄÆ›Kd‡’¼¼’—Œ[Ž$ŽÂ=¹ÂÛ•X‰¿Ž…Tcˆ’ q±d <í¦áݽ{ðÉÉ®‡˜‚̪‘‘sÍs s‘ ggÅÌÓ,ó{½““"¼¼¼¼4’‡‡{‡½’††±¼zFœÃ‚Á]Á¦Á~ÊzudšÊ<gg‘ggggÅvÁMÊ,á³F0³³ +¼½®ˆË}T…=ÂÂ$¿X¥‰!€GŒ}
}Œ}»´…Q«¹[QGHÄð½¼z³Àz¼D†’½½½‡o{{ý‡‡ŸVEtt†D¼±±˜'±˜ +zY Š²õ]~õ‡É@“ÁvÑ?ÌÅÅgg>gvÅv–‹œD‡ÄËââ÷e@‡Ÿ’É™TÂX••$lŽl$¿¿‰XŽ…:J4q³šd@± <–~z·rrr®Ö²’³¦g>s‘ ‘Í‘‘Í‘‘‘gggÅÑÃÕ±uVš¼ ÀŠ +“"††’’‡²Eš±±D¼˜Fqw‚x¦Á‹‚z†u@ðC“‹Åg‘gÅÅÌÁÃq,œ,œœFÀz4¤Ä}:……«[Ž$‰ R¿!¹GŒ}}}:T…«ÂÂ[=GµÞ_’“œ ³Š±¼’½½Ÿ½o½‡{_Ö{Ö°²*²V²½*š š±“'Š Y¼*¼áM]z@Š?¬ÑÑÅgŪÅg\gvÅ~œ®.H-öQQöâÐð/’N¾Œ=¿X¿‰ l¿é ‰¿^Ž…
ɼqœ*d®Š7<ÁqóÏÖrrÖ‡½’¼F\gÿss¯¯BsÍsÍ‘ ggÅÁÃ'Î’†D“ÀFÀŠz“¼†’½½u½’†t¼±†±'z,qMêÓê Ã,z*‡d®qÅ‘gggbÅÌ‹ÃáqÊœ,œ0³ +½®·.:»T…»»Â•X È6•€-ŒŒ}»|«€Â«´Ä‡tzœ,³˜’‡‡‡VŸ‡‡ýr_É__®ðr®r@{Ö{{‡½½†˜zÀtD³þþz½ð°gÅggbb‘ ÅÅÅÅmʽ®”ˆÄc¨…ÂÛ!•!…
©¾Ö½uð;¨Ž‰^º^^^y^^‰•=ŒJÞ{A0“u²³¦í7z’½®ÖV’U¼''ÃÁ‘g‘¯òs‘gg>vgª–‚œ“UÎD,ÊÊœ,³Y³ +˜¼’‡‡½‡½’†¼¼±zFqqq‹‚q,Š†‡_®{½ŠêggÅ>>>Ñ?Ó¸ÒqqÊ +¼‡É©µ-Œ
Œ
Œ»=•‰º^ Ž«…¨¨}
}
´¹Â…:µÞð½'³ÊœzU‡{®ÉÖÖÖÖ_”¤·¡i··#·”ð®d‡²“zY˜z qq“u𲂑gÅ Åb ‘bÅgÅ̦±‡rÞ쌻«Ž•l••[…J(_½²‡5ù=¿^yyy^y^^XÂ.˾VŠ ¼u®³¦–‚“’{Ö½¼˜ŠzÊÁ‘s ‘ss gggg>¬>ªvíÁ3zU†DÕFáqÊ,œ,œÀ³“U’²‡‡²½’’†¼t¼Dzz,ÒÊwÃ,³“†o‡‡o½“ÃmvÅ vbÑ\xÓ]~qqÃ3³D’®¤ËØ}}HccŒ»«Ž‰ ^¿Ž«T¨ŒµŒ}-¨|…¹»-žÞð’Š3œ³“’{ð¾·ð@‡Ö®rÉ·¤·èˆ1nÞÞÞÞÄÞnÞ¡·ð®‡†“À'Šœ¢œ¼dUêggbg ÅÅÅgÌ–‚,†{®”ˆì»…Žl•¿¥¿•ÂG씇h²(…Xº)ÔÔy¿•=}ÄÞr†ÀŠ†uu±œþ‚ D½{½“,qÊ0êg‘ ‘‘ gÅÅ>Å̦ó"¼UÝFÊÃ,,œÊ3,œÀz¼š‡‡²‡½½’†††t¼'zF³,Êœ±t’†½tt±³~ÌgvÅvÅÑ?¦xê]~‚q +†kÞžH}HžJ;ù
¨=•¿‰XŽ…»ŒŒ}}}ŒG´T¨H™ðŸz3œ +š{·1Þ@Ö{Ö®ð¤¾è1ˆ1Æ›ËaËËãËãËÄn·ð½UŠ˜ +³ z†š’³msb bgbÅ gí‹Êz’{ÖÞž…«ÂŽ•l••X•QŒ›Éu²/(¨•º)yy^•«».n¾A “½u½zœqqŠš‡‡½’¼ mÁ‚,~g‘s‘‘ sÅÅÌÑÅ–¦Ã,“'“"FÃwÊ,,qÊq FŠ±’²‡‡‡‡½½ †††t±'z³,ÊÊ,˜†tt†˜““œÁÌÅ>vvÅÑ–]ê‚q ˜ °ˆ©.HµË©Ë©Ëc¨…[Ž¿•Â¨
}Œ}c}-¨´´»ŒH©¾‡¼ÀÀ¼½ðÆÄ©Kð{{rÉk¾ˆè›ÞÄÆ...HH}µ}}H.Ĉ®Ÿ¼““Š +± t±~ÅgÅgg ÅgvÅÁó¼’‡{”Ë«ÂÂŽÛ•lX¿ž½’HQlºº‰¿•=:c.›·ð400†uE³,3¼²Vš“F‚mªÌ–~~‹Ìgfs‘‘ Å‹‹~ÃÃʘD“,Ê~ÃqFœÊq , z“t’‡{{{‡½½’š†t†±ÕœÃ~ê~œ'±±³ÒqáFFÃÃxÁÌѪÑm–ê~q +±{@ÞÄ.ž.;Ë;Ëù:|…[»ŒµHµH}}-G»¨c.Þܽ¼Š±‡L÷ž @‡Ö{_ɾ1ˆÞÄÆËJHc
----ž¾ÖŸ¼"““š‡†7ÿgg gbÅgÅÅ?~ʘD’‡®ˆH»«Â€[ŽX¿X€Ä®’/ÜË}Q€Ž=»:Œ;Ë™·_V" À½²†³œ³˜š’†ŠF3¦ÅÿÅíÁ~ÃÁs s%Á,''˜D± +Àwq~wœFœ,³,³³À˜š‡{{®‡½’ ’t±œq‹–––]Ò³z¸¦êÃq,`~ÓÁxê‹êqœ˜¼ð·Þ©..JËËù.c}:´T|……¨¨HcžùËžHc}-¨:}Ë讟†oðûâž›dE†*½Ö®Ü¾¾ˆ1ÞÄË.JcŒ-»´´´.ľr ¼¼U½±,mgggggÌgv>>ÑÁ‹q³˜¼’‡¾ËQ«««…|…¹Â¿XGìð½ŸrÄããË™ˆ·d½Š "²½D˜F³Š˜t’D“,q~–ªg>Åv¦Ã~ÌÅgg‘ Ì‹Ê'Ý''zFqË~‚Ê,zzŠzŠ'Š±†š{{{®{{½½²’t˜zæÌÅÅÅÑx]ü]vvvÌ‹ÃF'F³,œq³³¼šdÞÄÄË©ÄËËž..µH}Œc
cHìËÄ©ÄžH}-»´T©·r‡_·ã-L¾*U˜U†½‡Örðk¾ˆÞÄÄ.c:-…G}ˈɇ †’E‡'¢–ÿgÅgÅÑÅg?Áwœ +±’®›HG€………´¨G»QÂ$¿$|H·½½ÖððððÖŸrÉÉ”ðr²“¢ ¼½š˜À³³±t“ÀÊqÁívÿg¬gxÃw‹–Íg –‹wÊõœÃ‚‹¦Áê~Êœ˜˜D±D˜“±†š{{®®{{’½†±˜,ê–ggÅg¬v\ï\>øª ÊÝDÎtD±'±tu{d·ˆÞ™Þˆˆ™ÄÄÄìËìËìË;.ù.ìË©™Þ™Äžµ-|»ìèÉkLö؇,,Y¼ ½‡rÉð¾¾Þ›ËÄ.µc}}ŒŒHHÞ”{½½{†,‹ggÌ–ÁÁ‹x‹~q,zzŠ†‡¾Ë}G-T»:}}:´ÂX$€H¤Ö‡{‡†˜z˜‡‡®®‡t³q7þ'’*Š,³¼t±FœÃ‚–Ìg>g>g¬Ì~Fá‹ÅggggvÅÌ?x?m?mm?¦~q³“t’E½’’t š ²½{®ðð{‡‡ š±"zq‹mÌÅgg¬>\v\v¬>gªÌí‹Ê'*š²½²‡‡{°®ÉÉ””¾¾ˆˆèÞˆˆˆèÞ™ÞÞ©ÄÄ™··¡·ˆÄžH}J}»-´ì·¤›.âžð£ÊâF±†½‡®rɾ¾ˆˆ(ˆ™(ÄÄ;©.ž...žˆ”{‡E½ ³‹ªÅÿgí‹Ê,,ÊÊœF³“½ðÆH-G-¨ŒcžH}¨Ž$€µ¾Ö‡’±0qq0z’V’† +qêíê0t ±Š,œFz±± q‹‹mÌ\ÿg¬g>ÅxÊ,Ê~––vg>g>g\g\Ì\–¦‚q0z ²²‡u½²‡u‡‡{®ðð®{‡’’†±zÊ‚¦–Ì̪vvv\v\v\Åggg–ÁÊFzD†E½E½²‡u‡‡ÖÖ®rrðÉÉÉk”Üðk¾ˆèˆˆè·”ÜÉ”_”èÞÄË™.H}G´µÞ蛞÷†¢–Á~Ê +±’½{{®®ððÉ””Ék¾¾¤ˆ™Ä©Äľɇ½š'qÅgÅ>g–ÃzU±zzzFœ,ŠŠ’{Þã-}cc...ì..ù€ˆ—†,‚Á‹Êõ'0~¦ÅíÑq˜*š³ÃqœŠ'tt"œq~¦xÁ?–ÑÅ>ÿ>ÿ?êáÕ,~Á?ŪªªÅªímê‚q0Š“†½‡{d@‡{‡{{{®ð@{‡V’“œq‹ê‹ê‹¦?\?\Ì\ŪÅÅÌÁ¢YŠ¼¼†††††š’’½½‡‡‡‡‡{{{Ö{r®”¾””ð®®®{r®®”¤ˆ”™ËH}´G}™›Ë®À<gÑ‹ÊŠD†V‡‡‡Ö{r{®ÖÖ{Ö®r®Üðk¾ˆ¾É{’†tUÀÁÅggŪ‹œUU±D'z,³Št{HH..ËìËìËÄ™.¨=€-™{‡3ÁmÓ‚ÊêÁmÅÿgm~zšŠ~7qFz't'³q~7xÁÁ]ÁmÑívÅ>Å–¸F˜óD'Õ³á,ÒÊÒqʳz˜˜††š‡{d@®{{°‡°{®{{ÉÉ®‡½’†˜ŠœÊqÊq,œõÊqÃ]Á]Ám–Á¦–Á7~Ã3FÀzÀŠŠ˜¼˜U¼¼†††’†’’’½Ÿ‡‡Ö_”_ÉÉ_®Ö‡{{䇇r®Ér”ˆÄ.-žˆÆ·’ P>ÅÁÊzUš½½½½V²V½‡½½½½½o‡‡®ð®ð®‡ ¼˜UzÊÁª>gv–ʼ ½±±“ŠŠ“V{ˆÆ.HžË©Ë;ËÄËÆûÞ1ˆ©JG¹TˆýV˜ÃÁ?x??bgggg–wzD±FÃm–ó'“DzÊ ¦êÁ]xÁx–Á?í̪vª?~ÒDt*u½u{‡‡‡‡‡{{®{®®®®ð®®®‡‡‡‡ðÖ®ðð@½½“Fœ,q³˜DtttD“, Ãê~‚qqÊYYŠŠŠ“ÀŠŠŠŠ“˜“˜D˜'¼˜¼¼¼†’½‡{®ðrÉð®®{‡{‡‡‡‡‡ÖÖÖÖ܈©cËèˆ{ÀíPÅv–ÃœF“D†tš†’†t’¼¼““¼¼’o{{‡½’¼“ŠzFq?Ågí z ‡V’št½ðÆË.ÄÞÄ©ÄÄ™ÄûÄ›¾5¾ÄŒQ-™‡’"Ë?Ñ>>ÅÅ–¸Fó˜,êí̦3z³,qê‹êM‹‹x¦x¦ÁxÁ]Ìví?ÁœF²dú·ˆ··”ð”ðÉ®®®{‡{{®®®®Éðr‡‡{½t“³,œ³'±tE‡utzÀœœF³'DE‡‡‡½½’†¼˜"˜˜ŠzŠz““†’½{{r_É®®—®r{{{{{{ÖÖä‡Ö{rɈĞH˾ðɆ7gÿb>ÌÁʳz˜“D¼˜'˜'˜"zŠ³ÀzŠjt½‡‡‡E’U˜zF³Ê~?–Ñ‹œ½‡‡‡‡‡®¾ÞËÄęޙÞÞÞÞ›¡ÉܾùGˆ‡±ÊÁ?Ñ>>>Ì‹MÊœõq‹ªgí‹,³³0q‹êê~Ãw~Ã~‹Óê‹~‹¦x–]Á¦¢ "’‡®”ˆˆÞË;ËÄÄÆÞ·#®r@Ö{{®Ö®ðÉðð@‡Ÿ{ ˜Yœ³˜˜t²‡°r@{{’*tt± E{@›ˆ·ð®u½šD±'zz±±’²{ðððððÉðð®ð®ð®ððððððr®ðrrɤˆÄË©”Ö{'<¶‘vg?qÊYzŠzŠz +z qœÀz“±†‡°{°{½±ŠzzFq~ÓÊF{@r@®d®ð·Ä›ˆˆˆ¾è¾™ˆ¾¾1iÉýÖì--臇UÃ?v>î >vÁ~,wÁ\gIÌ‚,zFœÃê‹‚~qÊÊwq~~M‚M‚~]‹]7à ŠÖðɾ™Ä.ž.ž.Ä›¾ð#®r{{Ö{Ö{@rðððr‡‡ð½“³³Fz˜±DšV{@®”@ððd°u°C@Ú+.ã÷ã›·®°št˜Ýz˜t*u®·”ðð”··ˆ¾ÉÞðÉ”¾èÆ›·®†ÃÌg>gÅÅÌÁ~,Ê,FF,œÊqwqqqÀ“’Ÿr®É”𮇽†“Š³YŠ““†‡®ð®ð®®Éð·····ð¾”” ð®ð®‡½·-H¾ÖC†ÃíÅ>Ñ?ÓÓMMx?<‘gg–ʳF,Ãê~~ÃÊÊŠzFz,œqÃqÊqœqq~qÃqŠt‡®ð™ž÷HJËÞ¾”®®{{®{@{@{ðð®®{’ {{š'À³À³z³z˜t’½‡®ð·¾·¾··¾ˆˆ©ËH}ŒŒžì©ˆÜ‡½’¼†’Ÿ‡É”_r_—{ܤ¾èÞ©Äì.µãËLÆHƈ¾_”·ˆÞ·{'‚Ågg‘gÅ–‹Ã`wÊÊ~qÃqÊq³ŠUŸ{É”¾¾ð®{’’±"Š˜“†½® ð#ðÉ__·ðððÉ ”@®{{®ð{½’ð.É{qÌÅv>?ïÓÓÓx–Ñg‘I¦ÊF,q~‹‹qÊq,Š'zF,qÊœáœõœ³ÊœÊœY˜½{®ðnÆãcµË©Þ¤ðð®®®®®{®ði𮇒†{ d’˜³À³³³Fz“t½u{®··ˆ›ˆÞ›ÞÄË.µ}
}ùË왾®{½’’½‡®ððÜð®ý{Ö𔡈›ì.µØ-âØQ-ì޾ɔˆ›·ŠÁÅ>>ggÅÅ–‹ÓÙ~~êÓê~êqœ'†½@r·¾·ˆ·¾ðð{‡½†“¼ ½®¾ˆðÉ®r®É®_®ð{{®®r®Ö{‡‡{®¡rh¼‡›Þ@Ÿd*Ê<vÅÑxÓx?xx?ÌÅÿ‘Å‹œ,ÃMêÁ~ÃÊ,z +'DtDD˜zF³³³Fzz'z˜“D’½‡{r_”¾™Æù.c.Ä›¾ððð@rð@rðð{½¼D®ú®tŠ³³³À³³Àz“†½‡®É¾ÞÄËÄËËžHc}}µËìÄÄèð{‡Ÿ‡®®ð𮇽½’½‡Ö”ˆÞ©H:…«Q€«lQľk¾ÞÄ·‡œÌÿ>ggsggÅÌ?––?Á?¦ÁêÓqœ˜t½{É”¾¾ˆˆ¡··ðd‡½’½‡{·”ð®r{{‡{‡‡‡‡{{Ÿ ’’‡{𷛇“’”‡V qÅÅÑ–ÓxÑÌÑÅgg‘mÃ,‚ÁÁx‚Ãq,F'tšt±'zz±±±t†š’‡®®_Éði·è.JHHžË1¾·”ððrððið{šŠU®·@tÀ³ñzzzzŠ'¼t’½‡{®¾ÄÆË...µH}cž©™ˆè舷{‡½‡{®®{½’†¼†4’‡®¾ÞË»=Û$l¿¿¥6lTžÞ¾¾™ˆV¢Åg>gggggÅbÑÌÌÑÌ–¦‹‚³†V{®ð”¾·¾Þˆ·ð{½‡{𔾈޷”®Ö‡‡Ÿ½½½½½½½‡‡V’†’ ‡ÖˆnË1Ö“4@®½†{²ÊÌgÌx‹ÑÑÌvÅÅÅgIgÅ‹q,ÃÓ?ÁMÃwÊœFzDš*’E’’¼¼“¼U†š ½½V‡‡ðð””””¾©ËµH.Ä›¾·”ðÉð””··®½¼ “°“³Àz“˜““D¼¼’½‡{ɾ™ÞË..H}
}}H.Þ”ððð··_‡½‡‡{°½t¼˜''4ŸÖ”ˆËŒT«[•¿‰‰^^ƒXQ
Þ5ˆÞ.ˆ²þvgg>g‘ggggvÅÅvÌÑíÁqʘ±šu{@rðÉɾ¾1Þ››·®Ö{{É𷈷ɮ֒’’††††’š’*’†¼¼U4’‡r›ËãËð4†®ÖU¼E’,ívÌ?Ób>ÅgÅÅg‘gí~ÊÃ]Áx¦Ó‚M‚~ÃqF±šE°²E’†††*½²Vu‡°{ðkkð(ìJ}-µãìÞ¾·”¾·ˆ›·{’“3"··‡˜ ³“tët¼tt½½‡{®ð”·¾›ÞËË.Œ}
H줮Ÿ’‡®ð{‡½½²‡²†'ÀFÀŠ"‡r¾ÄcT=Â$‰^RyÈRX«:¾¾ãÞVþÅÿvvgggggg vgÅvÅ–‹qF±½‡‡{r®É¾ÆĈÉ{{֮𔷾ևŸ¼¼¼¼†t†t†t“"“"¼ /Ö”ˆÄµ}·½’®{“Š*š,íÅÑ–xÅ> Ågg‘sIÅ–ÃÒMÓ?xxÓM~xÁ]‹q,zDt‡{{‡½½½’½½V‡‡{®®¾·¾·”kˆÄž--H.ìęވÞÄËÆ”½¼À3¼··EÀqŠ±’š†’† ’½‡{®r”¡ˆnÄìùµH¨}}HÞ®½¼“‡®_‡‡²½²’˜,,FFF“†Ÿ¾ÞJ
…ÂŽ¿^^^^ l=}5(Ä.ƽ‚ÅÅvÅg‘gggÅ >gÅv–],zDt’E‡½Ÿ‡{ÖÉ·Þ›ˆ¾ð®Ö{{rð”r‡V4¼““““¼††±¼˜Š³ŠU4’®¾›.Ø´öć‡ð{¼Àš,ÌÅvÌ>ÅÅgÅ‘¯gªÁwÊ]–]Á]~¸Mm?–Á‹qFz½dd{®Ö‡½V½‡u‡‡{{®ð·ˆnˆèˆˆ©.
´G-}H.ËÄÄì.H·’“À3˜½ 3z†²š½½²½‡‡{{®ðk·¾ÄËž.c}:}µ¤‡†Y š{‡uo’†t†±z,œ,³õF“UV®ÉÞ;
»=••¿^‰$[TcÄ(ÞÄHÄV¢ÅgxÓÌsg>Å>gvŦ~³'±š’††4 ‡{ð···r‡‡‡‡{{{‡’†¼"Š"“"˜'˜ +z³Yz“± ‡ÖɾÄ.}GQž”É®r†¢zDzÓÅvÌvÅbgg‘ss>Ì~qw~xxxÓÓxÁÑíѪm~qF± °{®ð®®Ö‡‡Ö{{{{{®{®ÄÆÄÞè(ìH¨G»-c}ŒHù¨Œ÷Ɇ“33½·uÀqŠ²‡°‡½½½½‡®r{ɾ1ÞûËžcŒ-}HµÄ_½“œ‚ʱ½{‡š’t†DŠFœÊ,,F˜±’‡®·ÄË:»Â•¿^•€-J™ÞãÞ²¢vªx~mgggg> >gÅÑ–~œ“˜"˜"Š +“U4’½Ö®””ð{½Ÿ’‡½½½’¼““ŠŠŠŠŠ˜ŠzzYzŠz¼†’‡r”ˆ©H|Qµ›”ð½3F˜êvÅvvÅvggssIÅmÓÃÃÓ]Á]ÓêÓm?ÑÌíÁ‚ÊÀ˜tV{ððr@rr{{‡{‡‡u‡®®”›ËËËÄËž-»…G»G¨-«Tã@4“ À‡›·‡³3F†u{{{‡‡‡‡{®®ð¾1ˆ›Ä˵HŒ}.ì·®tÀqÁq’u{‡²’š†tD˜FFœÕ±½®ÞÄŒ:…«Â•ŽÂG
žÄÞÞËV¢Ågx~–Åggg >gÅvÌm‹q,³Yœ0œ YŠ“U¼’½‡{®®{{‡½ ’’††““ŠÀF0,,FœF³F³³zz“±’‡rð”Ä.}G¹-.è·ˆ® qF³w–vÑÅ>gssÅ–‚Ãw‹ÓxxxÓxÁÌ–m‹‚q,z¼š‡{ðð®®Éð®®®®®C{u{°®ˆÆ.ž.c}:|=«[«•Ž«›“"ÀA@›{“3 ±Vdð®®®{r{rÜ𤈩û.H}H}HžË™ð‡“œ~¦‹œ“’{‡½½tt“³FŠz˜¼’u{èÞž
¨T»«…»JËÞ(Þ©ÞÞƾ½qÌÅ‹Y~–ggg>ggvÅvíÁ¸~3Ê3Ê3, z"˜¼’²‡‡’†¼††±¼zzYœ,œ3œq3qÊqÊœ,³˜"t’{r𾈩.´|-˛ķ“~qÊÃxÌvvb>Åggg‘‘íÁ~Ãw‚x]‹]‹]xÁÁxêqÊœ +˜²‡{@Éðð”ðÉð®{‡½²½‡{Þã}-}¨GÂÂ$•••¿R•¾’““Š†®››ðt œŠš{”Éðɮ𔈙ÆËžHcµc.©¤®½± q‹wᓆ{{®°‡’š†D“"z"±tš‡Öð·Þ©.µŒŒŒŒcÞ¾¤¾èÄÞÞˆð†íÑ‹,ÁÅg Ñg>gÅÌ̦‹‚âÊ3,Š¼˜Ušš½t†'zœFz'±'œÊqqÃqÃ~Ã~~ê~qqœÀ¼t’½‡®ð¾Þìc¨´HÄ.›’‚ÃqM¦Ñvvvvg>ÅgÅÅÌ‹‚Ê~ÓÁ–xÓ‹Ó‹‹‹‹‚qÊœœ³˜¼š½u{{ððððððd‡šš¼t†’‡Þã-G´T«[•¿‰RÈÈÈŽŒðAU¼Ÿ››½Š3³U‡”·¾·¾i”Ük·™Æì.H.ËË©Þ¤®o†z,qœ³Š†‡®®ð{‡{‡½½†’’††’½‡rÉkˆÞ©Ëì.žì©è”r”ÞÄÄÞ·®q–ÌxÊzYÖÅgÅ>gg>Åvª–¦‹þÃœ,À˜“±˜†t ±“,¢‹7qÀFÀqÃê‹ê~‚‚Á¦Á]–¦~q,˜²‡‡{®ð·ˆÞÄž.Œ-…ìHÄrœ~]‹x–vv>gÅgÅm‹Ãwq‹x]Á]‹¸‹¸~wqÊœ,œFŠ'¼’½‡‡®®É®®{²’±˜³Šz“†‡”ˆµ¨«[Ž¿X^È)‰…;‡U“ Ÿ®Æn·u¼œ ŠDÖ®”·ˆˆ·¾k¾™ÄûËÄ™ˆ¾”ð܇½š¼'zÕz“’‡{®ð®ð®®{{‡‡‡½‡Ö{_𤈙ÄìËììÄ™›¾_¾©.LË·‡“3‹íÁM,ÃÁÌÅ>Åg>ªÅmÁ‚ó +zzzÀ˜“˜zÃÁªÅÁ~qÊ‹mÌ\–]x–\ÑÌ\Ŧ~³˜²{{®ð𾛩Ä;ËcŒGGHHã¾'q–¦x?ÑÑvÑvvÌÑÌÌÁ~qÊ~‹]–xÁÓ~MÃq,qœ³œœqœ³zŠ±±†š’½‡½½†¼³œq‚q3qÀ“½{ˆì´ÂŽX¿‰y‰‰Âc&‡"4VrÆLn½“z +˜’‡Ö”1Þ™›è¾·k¾¡ˆ¤¾rÖÖ‡‡o½št±D˜¼’½o®ÉðÜðð—ÉÜ””¾¤ÞÄ©.ù...Ä.›¾›.â-H”‡"q‹–x‹Ê +DF~–Ì vÅvggí–¦Ã0z'±D˜'³œqqÀzzŠÃmgªÁ‹ê–\gvíÑ–\gvªvÿvÁ¸³±‡d®®®ðð›Ä©Ä;.cG»HHãÄDqÑÌxÑÑ??–??–ÁÁ¦ ÃÃw‹Áx¦ÓêMq,FF³,qÃ3q3œ³ŠzŠ±¼““Š q7¦mmÁêþ "4—¾ž-…=ŽŽ•¿‰•Â»(&4 +¼ÖLããã’“Š"j’‡ˆÄÆě跔i¾k”Ö‡Ÿ’44’h‡‡u‡ô²t±†’’½{ð·¾1ˆèˆ1¾¡ˆèޙĞJ}}Hž´µcŒŒ«€´z¢‹ÁÁ‹q³±DzÃê]?\>\vÌ–‹ÀŠ¼†±FÊÊÊ,YŠ'ÀÁsÿÅÅv?>ÅvÅÅÅÅÅ‘‘‘gÅgªÃ +‡®®ðð®ð”·Þ©..ËË.--Œ.ËdœÌª??–?ÁÁ–ÁÁÁ]?êqqq~]‹xÁx‹MʳzFY,0ÃÃM~MM~M~~Ã~wMÓx–ÑÅÅÌ––Á¦‹qF‡ÆHG«Ž[=}Þý’U4”ÄH
¨.;Äˆð‡†““¼’‡ÆËìÄ(¤”É®{E'0Ê,F˜D†š½u‡½½½’44’’‡É·ˆ›ÄÄ©©J©JžùŒŒ¨»…|…|…´Â|»»…ÂŽ…›rzÃê‹Á‹wᘱ˜œqÃ]Ñ\vÑm‹Ê“¼t’¼'œÊÊq0³'†U¢Å‘gÅvÌ >ÅvvÅÿgs‘‘‘ÅÿÅ~“½#ðÉ®®ðˆÆãH÷...µ
HÚ“?ªÑÑ?xÁÁÁ‹Á‹x‹‚qqqÃêÓ¦xxx~œõzY,3Ã~‹‹xxxÁ?–Á–Á??Åv>>Åv–Á¦ÁÁ‚ÃqzU‡Þ.}-»´-µÄŸ¼¼ Öˆ.T
µ.Äu½’†’½°Ä.ËÞÉr{’zÊ‹êÃq,z±t’½½½½‡‡‡’’ Ÿ{#¾ÄËJccc
¨-¨|……€€ÂÛŽŽ!Ž¥ŽÂ•l«_˜q‹êÁ‹qqz'±'z³w‹Ñm‹Êz†’½E’DzFFÊq,³ +tV‡¼ ÿÅÅg>>ÅÅÅggg‘‘g‘gª~¼ð®ðr®ð¾©.}-´-µ.žJ¨H;EqÅ>í?Á‹‹‹‹~~¸M‚qÃqÃMÁxÁ¦Ó~qá,³,,Ã~¦–?ÌÌvÅvÅÅÅŬg>gv––ÁÓ~~‚~ê‚œ“½{·Þ©.ËÄ·ð½“4”Æ:|…T¨HùĈ·ð{‡’’½ð1˵™¾”{’Š‹ªÌ¦~qFŠ'¼t’‡‡Ö{‡‡’4U’½{@ˆËžH}TG=Û[ŽŽŽŽŽ•Ž•••••‰lŽŽŽ•l…LðDq‹‹‹‹¸Ãœ˜¼t±³wM]‹Ã,"’²‡½˜F0qÃÃÊÀ’°@{z<ÅÅ> >g>gggs‘‘ÿÅqU®É®®{èËGQ-c..cŒH.dFívxx‹‹~ÃÃÃwÃqqqq~‚ÓêxxÁÓMÊœ,Ê~Á–ÑÅ>\Å>ÿgIgvv¬vÅ?‹~ÊÊ,FœÊ‚‹ê +4‡Ü”ˆ¤Éý’¼¼"’{ˆØQÂ=…T}HËûÞ›·ð{‡½{ËH.¾ÜÖ¼3ÌgÿÌÁqFz˜±¼†’½{®®Ö‡½ ††’‡É·Ä.´…•X¿¥¿l•••••¿¥¿‰l••ÂÂ[´ð±qÃê‹~qqq±D±'záqq,Š'½½½’± +œÊÊqÊ,Š*°·VþgIÅgg g Ågs‘‘‘gªÃ†{®{®Äc»…[«G¨H;.
}
žð˜êvvÌx~~~ÃÊqÊÃqqÊqø‹xÁÁ]‹‚ÃÒÃÂÁ–ŪggggÅgggg‘ªgÅv–‹~ʘD˜ÀœÃqÃq +¼’‡{‡½¼““±†‡É©-«ŽÂ««»:cž.ËËÄ·ð‡‡ÜnµÄ¾®{˜êÅÿÅ–qÊz'¼±¼š’½Ö{ðð®{½’’††’‡®k›žâŽ6‰‰‰¿•¿‰¿‰‰ºRºº‰‰•ÂÂ=}Ä®±qÃ~~~wqÊœ˜“±˜Ýzõ³FF˜U½½š†À,0qÃq0³’ŠgÅg>ÅggsÍ‘svgÌqU®®Ö‡‡®ù
|[Û€«-Œ.cµ
µH›ðDq̬Ì?‹~ÃÊ,,qá qqÃq~Ó¦xÁxÁ¸Ã~q~‹ÁÌvg>g>ggIggg>ÿѦ‹ÊõF'D*² t“œ,¢Ê À“¼††““Š˜†²Ü.€Ž[Ž[«»ŒHHž..Äð{Ɉ}
ì¾®½³7ÅÅÌ‚,z'±±t’’½‡®”··ð{‡½‡‡½‡{©÷…‰R‰‰‰¿‰ºÈÈÈÈyÈ)ºº¿Â«µ›{˜œÊ‚~ÃqqqFÀ'˜'±z³Õz˜U’‡²’¼“FÀ,À,Y³ +˜š°É†‚ÿgÅgg Å gÍs‘gŬ–,¼{{ŸV‡ðÆŒ»[Ž•XŽ[»¨}Jµc}c†œÁ\g?~Ãq0œF³,œqÊqÃq‹ÓÁxÁx‹‚~~Ó–?Åggggsg‘gªÌÁ~,F'''¼*½‡V±'³Êœ,À³ŠzzŠ˜±‡dˆ©¨|ŽŽŽ•ŽÂ¨ŒcHËH.Äk{Ü©.¾‡†Êígª–q˜˜'±†š½½{{”1ˆˆðððÉ_‡ýÉnË»[‰ ‰‰‰¿^ÈÔppppæ)y‰Â…-ì{˜,qÃÃÃÊq,œÀz“±ózÕz˜D’‡‡½’¼ŠŠŠ'˜¼E{ð·‡qggggÅ g‘s‘gÅÅmF¼Ö’’‡Æ¨Ž•X¿$Â|TŒc.cµ· ³êg>m~Ã,FF³Fœœqqq~~Áx¦xÁ‹êMêÁ?Ìvg>gÅssggggÌm‹qFFFFzD†®°{Et'³,œ ,ÀzŠ˜“šd©.´ÂŽ••¿•Â«¨:cùË.ã˾®kÄ}-H”u¼Ã\ÅÌ‹,˜''˜˜t†š½½‡{”·ÞÆěވ·”r®Üì:ÂX‰¿¿¿¿Ô)p„ +˜Uš{ž¨«[•¿‰¿^•Ž=»-HJ.HË™kÉ™}.rt“MvŦó³³,³z±’‡{‡{r¾Ä..ËžHµ.©ˆk¾Äì:«•¿••¿^pæ„ +˜˜Ý˜†uÖ®‡½t¼t¼’* ±U˜“{®{®‡³7gg>ÅÌÌ‘g‘gÅv–qt Ÿ’’Ö·.T…[ŽŽÂ[«:}cµµc}-Þ‡±œê–Ãœ +'“'zF œqÂ~ÓÁÁÓ~~‹ÁÑÅ>Ågg‘‘sggÅÌ‹þqÊÊqÃÊqÊF˜²®ð@u*¼Š“˜¼š‡ÆŒ»ŽŽ¿¿^¿¿•[«»c.©aËËÄû”kĨ|.‡DÀÓ\Ì‹ÊœFœ,qœ³Ut‡‡{{r”ÄžHcH
c.™ˆ(ìHT«$•ŽŽ‰^æ„„„2æ22Çpp^¿…J¤{’zÊqÃq,œ,ÀÀYŠz“z˜˜t½®ðÉuh††’’V‡’UzÀF±²{½½²'êÅggÅ–‹ÌgsÅg‘ÅÌÑxÊz’’’r›÷…«=«=«»HµH.HµGË®¼œq‹¦Ê³"˜¼D˜Šzz,qÃ~êÁÁ]‹~ÒÃq‹xÑggggs‘ssggÅÌ–‚ÃÊœÊÃM‚‹~qF¼’{®ð@‡š±Ut½‡ð÷»«••¿‰‰¿¿•ÂµÄÞÞ›Þ™¾¤ì|«Ë’ÀÊÓ?Á‚,ÒÃwqÃœzt½u{{r”(Ëc-»»¨-Œ;Ëc:…«Ž[ÂŽ‰y„„„„æppp)Çy¿«Ë”‡†³qÃq,3,³zŠŠŠ +z˜±š{”ɽš†š’’V°‡ ±Yq3z’‡††½†‚ÅggÑÁ‹–ÅgÅ‘gv̦Ӝݼ†4½ðLT»T»T¨T…:}Hc.žž.THK4,qwêʳD¼D¼±'“zŠ,q‹Á–Á‹Ã,œÃËÑgggg‘‘ssgÅ?ÁÃ3ÊqÃêÁxÁÓ¢,“†®ð@{² š’²{ðG…Ž•¿‰‰‰•ŽÂTµÄˆ¾#¾ˆˆ¤èµ[¹Þ4Ê¢Óx~~qÃq~ê‚qqÀ±’‡®ðrÉ”Äc-»T»¨c.cŒG«=«««Ž^)„æÇÇÔy¿«J”‡œÃq,œ,³³ +“ŠŠŠ˜"†²ð·¾®½9†’‡‡‡@’¼ q~œ˜½¼z±Ê–¬>Åx~ÁÅggggÌ–Ów,'±U¼UŸ@ÆØ»:T
Œ
-}HHËì...:ˇ³ Êq,˜†’’t†±¼'œ~¦ÌÌÑÌÓqÊFœÊÓÌÅg‘ss‘ssgs>Ì?ÓqÃqÊ‚Ó?m?¦~qŠD½{”””É®‡‡½V‡®·ÄµG¹Ž$¿‰‰‰•Ž«»Ë›¾®{É·¾è¤™¨Û…ˆAà ÓÓ‹wÃw‚M‚~‚Êœ“’°®ðr®”ˆž-»|…´:¨
}GT««……«•^ÇæÇ)yyyÔÔy «J”‡¼FqqFzYz'“'ŠŠ +˜“tš‡·”Öš’†²‡{®½D0q73³’¼Š¼D³xggÑ–Ó‹Áª‘ÅÅÑÁMw³'““U4‡”Æ÷
cJ.žH.HžÄÄËž.
-H”±qqq,zU†š ²’±†˜F‚–ŬÅÌ–‹q,œ,‹?gggg‘‘‘sggÌxÓœœÊwêÁ?m‹‚,Š†½{ÉÉÉ®@{‡®·Þ.-¹¿‰‰¿••Â»-µÄ¤ð{‡‡Öð”·1¤ì|ŽTÉ þ‚ÓM‹‚ÃqÂwÊqq³˜’{®ðrðÉ·©H¨-…T´¨-»T…»…¿)Ç)Ôº^^yÇy^‰«É½UœœFz“'˜˜"˜ŠŠŠ“±†‡d܇ht†½‡‡{@{½†ŠÃþqœ’˜"±‚vvg\‚q‹¦íÅÌ–~wáF˜'z“’Ö·›ì.ËËÄÄÄÄËËËÞˆÆË.Œ:›½³Ã‚q,zŠ¼t’t†±À~íÅÅ>Ì–‹qÃqM%Å Í‘ ‘ ‘ vxœÊœ,ÊMÓxx]Ãœ˜†‡{—ÉÉr®®ð”ÞË=Ž•‰‰¿ŽÂ…c;è”_½½½²²Ö@”¤ˆžÂ€c‡O qÓM‹wÃwqMqqq,À±’‡ððÞL}´´¨-GGG»T»«•º)ÇÇ)^y^yÔypÇ^X«É*“œÊz'¼˜D˜ŠŠ +Š"±’u®”ÖŸ’9†²‡‡{{†" ‚qœ’¼˜'±Å\gÑ‹q‹mÌÁMœÝŠ +“’{”››ÞÞÞ舾¾ˆÞ©Þ·kˆËc¨Ä°³‚‚Á‚30³“±¼š†D³~ÌgIÅÿÅÅm‹~ÃÙÁÅÅ‘‘‘‘‘sggÅÌÓMœœFœœÃ¸~]~q,“t‡{NÉÉðr®@”ÄH´[•‰¿X•=»cÞkÖŸ4¼¼’‡®””¤èùÛ…ù’OêÓ~ÃqÊwÃq,œœz¼š{d·1Ëž}Œ:-¨»Â•º)SpÔºÔyyypp•ËÖ’˜œœz²½†“““Šz'±D*‡dð{‡4U½‡‡®®®‡’†³¢~3±²†“U† +v>v?w,Ê‹ ‚ʳzzŠ“½ð·›”¡·¾·ˆ®{®ã있{U,‹Ó‹x]qÊz˜"UU0Ágg sgb–ZÁ–?ÌÅ>gÅggg Åv%xÙqʳzœqq‚qœŠ¼’‡{rrðr®ð_Þ;
…¿X‰•…Œ·ušD" +“†’u{®_¾.|€ö¾“¢ ê þMwÃÒÊq,qFY“U’{r ”¾ˆ™Ëì.žHØHµ
cT«$‰yÇ2ÇpÔyÔÔppppX…ÄÖ†zœ³±²½†“““ŠzŠ'˜Dšu®‡’†Ut ‡{®®ð{½’˜33që²²4 ˜ >>>vÓÊ,3ÃÊÊYFz +z +˜†V‡@#·r_r_֮ɷŸ’½ðÆ™©Æ‡±ÊêÁx‹Ó‚‚qqYY +Y~–gsg‘ ‘bgm̪Ū>gÅ>g>gÅÑÁ~q,zz³FœÃœŠ±†½{®ÉÉð__k›JŒTŽ$¿•«û²˜z³Š"¼V{{u°ð›µGLðŠþê7þ ~ÃqÊ,œ,À“†V‡@ð¾·¾¾5Þ©ÄûËLËù.c
T[¿^Èp2pÇpÇppp2ppy•ÄÖtÀœFš°½t““¼"˜z'˜’²½’4"U½‡{r®ð{‡¼ +œ0±u{½ ‡U Ìv¬?‚,FF³zŠzzŠD†’‡®{ý‡‡®ÉW®½"ÀŠ½èÞnɲ +ÃÁ–mÁ‚Ãqœ YÀ0À,~Ì ‘g gÅÅvÅgÅg>g>Å>Å–x~,œ³zz˜³z¼½‡®ðÉÉiÉð_·™;H»[Ž«
™rt³ÒÊ ¼ ½‡½u½‡ÜJµ·½œ‚~M~¸¸Ãqáœ,³Yz“U†½rð··¾·¾¾è5ˆ™nÄì.
»=¿ ºp22p2p222„„p)y$»Ä‡¼œq±u°V¼“¼¼¼'ŠzŠ't†U“Š¼’‡®®ð”ð{²¼Š ëu®{‡ÖV'~v>Åxà ''z³Yz“²½½‡ä½ŸÖ®··@†À3 ¼‡·™›·{†,êÌ–ê󘚽’UY³,~–Å‘s‘bgg>ggÅgvgg>ÅÅÅÑ–MÃœFz˜˜±D¼±’²‡{®””·¤ÞŒ:«=…Œ;É4zqqœŠ'4’††t’{ð·Ä.µ.‡¼œ‚Mê~~~wœ,,z“D†½®{@”Ék”¤¾ènÄìH:…=Ž$Xº^ÈpÇ2222„„„æ)º»Ä‡“ qtd®½¼††¼˜FœF˜'“ŠŠŠ"U’‡{®ðÉ·ð{½UŠ“‡ððr®@½Ê‹v¬Å\ÁqFF˜ŠFÀ³“˜†½EV²V’h½rˆ›K®’ +œ3³†_”››ðEUqÊÊ “½ð·ˆÉ’U˜˜' ísfggg g>bgÅggÅÅvÌ–‹ÃʳÀŠŠ'¼tt’½‡{®””¤¾¡·¡·1ˆÄžc:»»
J¾ŸŠœq,zD±U¼¼†½°ˆˆÞËľrš˜wwMÓüqÃ,,œ³˜Ut½‡{{{®®®®Ék¾èÄìµâ»|=[¿X‰ºypÇ22„„222È^‰»ÄÖ“qÊšd°†’††“œ,,œFŠÀœYÀ˜U’{®ð·¾·ð®½¼±‡ð®#ð@zq?Å\ÅíÁÃ,FzF³“±’*’š’’Ÿ{”››+{*¼F ³Š†äƛ෽*‡ð·ÆØ˽±š³Ã‘ggf>g >g>gvvÌÁ~wœ'“D¼±¼tt’*u{®®”¾¾ˆ·n›ÄžJŒ:»
ùÞr†ÀÊqœz˜˜“¼’‡·¾·¾”ÉÖ’tzœqü]ÓMÃqáœFŠ'±½‡{{‡‡‡{—¾™ìµØ´|…¹=Â$•¿‰^yÇÇ2222pº‰¿ÂTËÖŠqœ²‡††² ± ÊÃqÊ,œ,q, ³"¼ ‡{r”·ˆ¾·®½†Ö𔾷Š‹mŪÑm‹~œF³ÀzŠ±†t’t±±’‡”› {VtUzœœzŠç‡®›ÆÆÆ›·”ˆˆ.a›dt˜Dš*˜‹gb > ÅÅÅÅ̦ÃqzDt’’’ †’’’½‡{®ð”·¾(è›nÄL.HŒ
»:Œ©‡"œœ³z'˜†*‡dðð°{{½½Ÿ ¼DáwMMÓ¸q,œ,³˜¼t’{{{‡šš’½Ö”™Ëµâ¨
:G…=ÂŽ¿¿^^pÇplj¿•[»ËÖz¢q²E¼†‡’DÀÂÃÃÃÊ,q✳“U’{®¾·ˆ›ð‡’{ɾ›šq‹Åª?–êÊ,³FŠ˜t†*’±±"“¼‡ðˆ@®E’D“³Y³A“†’‡®Ú·e+›¾”ˆÆÆðDœ³'²EUq–<gÅbb g gÅÌÁ~F˜²u‡‡‡½’š½š‡{{®É¤ˆˆ›™ÞÆËc¨:»Tc©@½À z'˜˜“±š{®u’†*4U“"U¼'³ÒwM]ÓwqÊq,œFz“±²‡{‡‡†±¼†ŸÉˆìHL.ž.žJcc}:…••‰^ypp‰‰¿Ž[ÂHÖŠê³°{’’’’q‹~~~w~~ÃqÃq, +“†‡®Ék›èˆè›ˆ·r‡‡ÖÉÄHÆ’ ê¦Ì\ÁÁ‚Ê '†’½½š†DŠz'’Öð®‡*U +˜zFz'Š“““¼†½‡ð𾈾rÖrÉšœ¸q˜š’,ÁŪ gg ÅÅÌ–‹q˜tšu{dð®{‡‡½‡‡{É𔾈ÞÄÄL˵
:»-숰*Š¼št'±u°½t¼³õÕ'"ŠF0ÊÊw~Ó~~ÃÊqF³zz"±†½®®{†'œY¼½rˆ™›ÆÆÞˆÞÄÄ.HŒ:»«Ž•¿^‰^^yy‰‰¿Ž[ÂH{À7Fd‡tV½½±,7Á‹‹ê‹‹ê~‚~qqY“ ‡®”·Þ›ˆ›Ä›¾‡‡ð¾›Äãã{±0‚]¦ÁêÃqF“t½u½’t“³z˜½{®‡†¼ŠYœ0,Y³FzzŠ““¼††V‡®É·ˆˆ¾krÖ½’˜q]–œ'’E¼³ ~ÅÅÌ–Á~œt½u®·ˆK·@®{{{®®É¤·ÞÞ©ËLËHµ-¨T»T}ˤ‡“½ t¼°®C²˜zÀ3᜜,q~ê‹‹‹xê‹‚Ãq,³z˜“'“±†²{®‡†qq"4{¤¾è¾¡¾”¾ÞˆÄùHŒT…«ÂŽ•^‰‰‰‰¿¿¿Ž[ÂÖœ7z°‡t½½* +~––m––?–?ÁxxMwÀ“†{®”·¤Ä™ÞÄÄÄ›¾rÖ‡rÄ÷H.ˆÖ†ÀÊq~~¢,Š†½‡®‡½†zY˜D‡uš"F,ÃÃÃœ,,À“““††’½‡{®r¾ÞûÄÄ”Öt¼˜qxª¦Ê±C’˜, ‹ ê à Y“†‡ðð·1ÞÞÞÞ¾”®rðÉi¾ˆˆ™ÄËË..µ:»T´G}›_*˜†®ð½†’·d²zÊà ‚ÓMÓx–ÌÌÅÌÑÌ–Á‹ ¢œ,³z'˜'“˜¼Uš{d‡¼á‹~³U‡Éð®®{{‡®@”·Ä.µ
»…«ŽŽ•¿¿^¿¿¿•ŽÂ÷Öqþ±dšŸ‡Dq–íÅÌÌÅvÅvÌ\–¦wYŠ ‡É¾ˆnÄÆ©ËÞ›#rÖ{”·›.H.{±zœ,q,³¼ {ðð{š¼z³˜š½t“qþþ~þÃÃÊ0œFz'“¼’½½‡{{ð”ˆûË.žÄ”½¼zœ¦\ŦF’d*˜,,,,,± uð·¡›ÆÆÄÆÄƈ·¾·¾·¾èÞÞÄËž.µ-»T…T´H¡ýDzEK’®·uq~ꦦÑ\vÅÅgÅgg>Ì–‹þÊœ³'˜D¼±“˜t’®’¼¸–¦0“®Ö{½t¼±"†½‡®¾ÞìcŒ¨««Ž•••¿¿¿¿•Ž[ŽHÖþ~t®½†VŸÃÌgÅÅgÅg>ÅÑÑÑx¸ "’{®èÞÄ©ÄÄËËÄľÉ{{ð·™ì}¨J{š±'"Š"’{ð·”{’“ÀÀDšš'q~‹‹‹~ÃÊÊ0F +˜¼t’½‡{{®É¤ÞÆL÷ˈ{¼zw]ÅÿÌ‚"@V†’†††’‡{ð·n©›ÞÞaÞÞÞ›ˆ·ˆèˆèÞÞÞÄž.HHŒ::»T»-žoz'‡Æˆ‡‡¾tÊêÁ–Ìg>gg‘‘ b >v–Á~ÃqœF˜˜±±U˜“¼š{°’ŠÓÑÁ0‡@V†'F,Êœ,'¼’—Äìc¨»«ÂŽ••X¿¿¿•Ž[ÛH‡þ¢šE’‡ œÁªÅÅggÅ>g>Å\ÅM0“’{ð”ÞûÄ©ËìËÆˈ”{®®i›Ë
u½*t’ð¾·Ö†Šz˜†²tzÃê¦Áê‹~‚Ê FŠ'"¼ ½‡{®®—ðð¤™ËìËˆð†³‚x\gÿÌÊU°@dCC‡C{ðð·ÞnÞ›™ˆˆÞÞÞ›Þ›™›ˆ›ÞÞ©Ä©Ë..µH
}:¨:¨-žðç˜ðÞ‡Þ°z‹–Åg‘>ggg gÅ >>>vÌÁþÃœ,³'¼¼t¼±†’°{tÀÁÅÁF ½¼F3êêê~~ÊÀ¼‡É1˵Œ»…«ŽŽ••¿‰¿•Ž[ŽHŸ~3²‡½½4~ÌgÅggbg>v>>>?M “½{ÉèÄ©ÄËìËËËËÄWð®ðèûcŒ
¨Ëd‡·ˆÞ·‡¼A +¼š˜q¦ÁÁêÁ‹ ~~Ê0z"¼t’½‡{®ððÉi·¾¡›ÞÞð’³w¦\ÅÿÅ7FV@ððð··™è舤k”””¾¾ˆˆÞ›Þ›™Þ™ÞÄ©ÄË...Hc
Œ
Œ
}Ë_ç³ ·Hˆ/ŸW†¢ÑíÌ>¯‘s‘sÍ ‘> >>ÑxMw3œz˜±ttt¼tš{{† vÁV07–Ì–xÁ]Ã3Š’®¡Ëµ»»ÂŽŽ•X¿‰¿•ŽŽãŸ‚ u°½¼‹ÌgÅÅgÅ> >Å>>\M “½{ð”ˆûËËž.ËËËËƾð®_Ä;.c
ØãÐ@@®·ˆ›Þ¾‡ŠY˜†²u³‚?m]‹ÁêÁ~¢Ê0³"'†’‡{®ð·1ˆ·¡¾¡·¾¾®¼³‚x\Ì\sÌʆC@···¤·kÉ—rrÉɾˆÞޛޛĩÄËž.ž.cc
c
µË_†³²ÆHW/’”“¦I>Ì gss‘Í‘g >î>Ñ?¸ÊœFz"tšš†t†½°{t ?vÁ + ½ +þ̪>í?‹Ó~q †{¤Æ}´»…••¿¿‰‰¿•Â!€Æ¼ Š®{Ÿ AÁŪ‘g‘ sg‘bg–wÀ"Ÿ”ˆÞËËËì.žìĈr®ˆËËJc
HËÞ··kð¾(ÄÞɇ“À†®†,‹ÌÌÁ¦‹êÃqq3 Š“†’½‡{ðɾ¾ÞÞÞ™Þ¾”É®r°F‚xÑÑ>>\ÁFš°ðܾ”¾”¾·®®{{{Vu{{ðˆ›ÞÞÆÄÆÆ;ËJùJHcHc}HµHL4“ÖÆØD°ÃÅ ‘B¯ s ‘ ‘ ‘‘‘‘ gÑÁÃ,3Š“†’½‡²’š²²½*˜,mÌqDš'ÌÅ‘ÅÌ––Á‹qq¼‡Äµ…«•$¿X¿‰‰•Â!¹ˆ“¢¼r’“–Ìg‘g‘‘ s ‘gÿgÁÃAV{#·ˆÞËËËËìJìÄÞ¾r‡‡ðˆûÄÄÄÞ›ˆ¾(ÄÄÞÖ’Š †ð†,‹ÌíÁ‹‚~q3,³Š'¼’½V{®ð”·ˆÞ©ÄÄ›¾iÉr{‡tF‚x\v¬>>–q'tÖ_ÉÜÉÉÉr@®{²V½½ š½{@ˆ›Þ›ÄÆÄÆËË;..µc.cµH÷µ.”’¼ÜËØ“³EÃÅ ¯ ss ss>ÅÌÁÃÊÀ¼†½‡d‡²’š½Eš˜¦Áqt*˜Ã<ggÅÅx à '‡ÆÂŽ¿¿‰ ‰‰^•Â€-Š3†·ð‡4 +ígggs‘‘gggÅÁÊ"†½r® ˆ›ÄÄ©ËËËÄ™·®½††°Æ›Þˆ¾·¾¡··ˆÞˆ·‡†³³ {’ÊÁÌ̦~Ãq,œ³Š±’*½‡®®”ˆÞÆËËìˈ”_®{½†F‚??vѬÅ\Áqš½‡{‡‡‡Eš*tt±¼““¼’½{ɾ·ÄÄÄìËËLËž.ùHcHµHHŒHµHL·Ÿ’¾÷سñ~ÅsÅ sB ss sP P‘sgg\–êÃœ¼’Ö®”ð®{½½’½’U“Ãê,tE¼Êgg‘ggÅÅÌÓ~œU‡·GÂŽ•‰^‰^^^^¿ŽžÖÀq†Ú®V¼ xÅgggs gÍgÅÅÌ‚,¼†V®ð¾Þ›ÄÄ©Ä5ˆr½¼³Š±{¾·ðrÖ{®®dðð·¾·r’¼FŠ²ð¼ÃÁªÅÁ‹ÒʳFz"˜’½{{®ˆ›ÞË.L.Ë1Ér{‡ ±F‚x?\ÑÑvÿŦ‚z˜¼††¼†'±Ý˜zFŠzŠ“†‡rÞËËËË..ãJHcH
µ
µµØH1ÖäÞØ ê³‹g¯s¯BBB s s‘ggvÌÁ~ " Ö”¾Þ››¤ð®½½V’†"œÃœtEtÊPÅgÅÌ –êʼu·Ë-|¿^Ryy^‰¿ŽTÞ½À ¼du½“¢–v>gg g‘ gÅÌ~,'†½‡ðÞÞÞ¾kr²¼³‚qq˜t°‡½’t±±±t9‡{®”®‡†Š³˜‡d‡†ÃxÅv‹w,Fz'±tV‡®ð¾ÞÆË.HHìÞÖ{‡’¼³Ã]?Ñ?\Ñÿ>í–¸wœ,,³FFœõ³áœœ³³Š¼’rÞËË..ž.ž.žµHµcHŒµ
}HHµ.›ÜÉì-✖qÁgg ssBBs s Psgg\í¦,“’¾Þ.H}HËÞ”Ö‡Ÿ ¼˜œ +tVšY–ÿggÅv>>ÑÁӔƎ•‰^yyy¿}¾4ÀÀ±½½ “þ?Ñ>gg‘ sÅÌ‹ÊÀ'†E‡{ð¾·k”_r‡†“q‚]qq³˜¼±Š qqqœz˜†Ÿ{{’˜ +z±‡d†ÊÓªvÌ?q³'±’E‡‡{®ð·›ÞËËžHËkr{‡½±zqMÁ?Ì\gªªí?¦ê ê~ÃMwÒwqœz¼½Ö·ÞË.HJ.žJHµHHHcH}H
µ
}HHµLÞ¤Hö-· mêÁg‘ss 8 ¯ s ‘‘‘>ÿv–qŠVrÞ.c-GGG-LˆÉ‡VŸ ’DŠ˜t ²± gÿg>>gv–ØVðÆ|•‰yyy‰ŽHr¼ŠÀF˜ttt˜¦xv>>g ‘bÍ‘ ÅÅÌÁ~q +± ²{®{{®{‡‡h’¼zœqqqq³zŠ³qq‚w¢ ñ†½Ö‡’†¼†½®®{½ÕÃ?ívÁwá³±*½‡{@ð”·ˆÞÆË㞈—{‡²†'³wêxxÁ–\íÌv\?Ìm–ÁÁ]~Mwqqz±‡r¾ÞË.žHµccHµcµµHH}
}
µ
HµHžÆ¤}Àm–mg‘Íss¯B s ‘gg>vmwŠ½”ˆ.H-
G.ˆð‡VŸV’¼U†*‡EŠ¦Ìgÿvgvv–~"²Þ•¿^yppy Âùr“Šœ ,z'±Fm?ÑvgÅg ‘ g‘‘ggÌm~q“D’²‡‡½½ŸŸ’’² ±“õ³œFŠz +ŠqqÒœ z¼’{É®Ö{‡{°ð®Ÿó,]Ì\Å?êÃÒF˜’E½‡{𷈛ĩËËÆè”𮇽t'³ÃÓ‚Ó]~]‹mm???–Ì–ÁÁ~Mwwwœ˜šÉ”›Ëž...cHcµcHcHcµHcµ
c.µ÷žÞˆìT¹GŠmí–gs sBBs ‘‘gg¬Ñ]³tðÞ.JHc.HHHžËˆÉŸV½tš½°†,‹ígªv¬v–q'VðÆ}ÂŽ¿^yy)‰•=Är½¼“qq,³œqêÑÑÑv Å‘ s ‘ ‘gÅ̦Üz“D¼†’’½‡‡rr®ð®{²t¼Š““Š““±tçäÉkˆ™Þˆ···¾®Ö‡ ˜q‹íímxê~qFŠ'†*½²‡{®ð¾ÞÆÆ©Þ”_®{‡’±zÊ‚Ó‹êMqqqqw~‚‹Áþ‹‹‚~‚‚q˜½®·ÞÄË.žJ.JµcHžHµµH}ŒµcHHìËLÄc¨G¼ê<–ªg‘‘‘‘s ss‘ggv]œšð›ÄÞÞƈˆÞ›ˆ·i®{½V‡‡V’†V{{tŠÃmÅÿÌ\ q"‡ðÞH«Â¿‰‰^^yº•[¨©”ð‡3óœÊqÓÑÑvÅÅg gÍ‘Í‘g>gªÌ‹Ã3,Šz¼†’’½‡rð·¾·ð°{’’4’½u¾žH:-HÄÆ››”r°²D³Ã]‹¦‹‚Ãœ,z"±†½‡{r𷈛ÞÄě蔮®‡½t˜,q~êÓ‚Ãq,³FF³00~~qà ±‡ðˆÞÄ©ËË.ù.cHJµcH}H}HHcµHJµ.žËËËì:»´Æ’‚m–Åg ‘ ¯ ‘ ‘‘gűuèð””ÉÉðÉ_®{{{‡{{{½½’½{{°V˜,w‚MqÊz‡@ˆž
ÂŽ¿¿‰^^Ž»HÞÞ›·uFqFqÊ‚êÑÑvÅ ‘ÍsÍssÍsgvÅmÁ‚ÊœF“D††½‡{®ˆˆ›Ä››”ÉÉrr”·›ž:¹=¨ØHĈ”¾ðð{’±Àqq‚‚q¢qYŠ'¼t½‡®ð”·ˆnÞnˆ”iÉ®{‡’Uz,q~‚qœœz˜tšV½V†" Ãq~qz {ð··ˆ›ÞÞÄËË.ž.ž.HµHHHµcH.c.JžËìÄž.……=…Öœm–íÅgg‘‘ss‘g‘ÌÌÒ˜urÖ‡Ö{{‡ý{½½½’½‡@@®@{½‡{®@®{’t“˜z“½{”ˆË}¨…=Ž••••¨ž™nËãdŠÃqÊÒqxÑvvÅ sÍsò¯ ¯fgÅ–Á‚ÊœF“˜“'†’½‡{®Éɾ›ÆÆÄÄÄÄÄËãØ:´Q«=…-HHÆÞ›ˆˆ¾(·ð{²“z , Êœ Š“¼²‡{®Éˆˆˆ¤”ið®{‡†'ÀœÊqÊqFz¼Eu@ð@{YÊ‚Ê“’{ð𾈈ÞÞ™ËùË.žHžHµ..žJì.ìÄÄìH}=«|H“ê–]ÌÌgg g g‘‘ÅÁ~˜ßd®Ÿ/‡ÖðÉðð{ä’†¼†‡{®@ɮև½Ö{ð®@u²{®ð”©.c}»»……G»èk”¤›HâC³Á‚ʜæÑÅbgsͯBBsÍs gv–~qÃ,ÀFz +zŠ“†’½{{—Ék·ÞûËL.ùHŒ-´-…=
Ë™i®ðˆÞÞÞ™›·É{‡†¼zŠÀŠzŠ˜U’‡{®ð¾¡¾1¾···ÉÉðÖ‡½¼"Š0q œ z¼’{𷈽“ ~‚,˜š½{{ð···”¾”¾ˆÞÞÄËãž..žËËìì©Äì.G«»ØˆšqêÁ?Ìgggbgvggm¢š°u½†4 Ö#ˆÆÄÞ·r½†¼¼’ð@ðrÖÖ‡Ö#”····”·¾¾èÞ™ÄìËË..ËËƇhýÉÆØât ª–êwq?ÌvggÍs ¯ sÍgÌ–xÃÊÊ,Êœ0œŠD†’‡{ððk”·è›Æ©ËJž
::-´T|T}J¤É{½š½{®¾Ëì..ì›·d{½t¼˜““˜¼š½{®ð”·¾·¾·¤·¤k𮮇 †“À,ÀFÀ˜š‡ð·¾Uœ~‚œ“D†½{®®ð®Ö{Ö{Ör”·è›©ÄìËìËÄ™ÄÄ©ËH´Â=»T}{zÂxÌÅÅÅgŪ–“ uu²’““‡¾ÄãHHãÞ¡r‡’¼’{@#ð@ÖÖÖÖðÉ·››››ÆÞÄÞÞ™Þ™ˆè¤¤_É_Öj£Ÿ”Æâã œíªÌm–¦–ÅÅb‘ s s ‘ Å–ÓÃÃqÃqq0z†’½{{®rð”kèûL.c}
´T´´GŒ.è”_Ÿt£˜±9{®·©ùH}µãž›ð{‡š†¼Ut’½{{Ékk·¾ˆ¤¾””ð{½ †“ +ŠzŠŠ¼†²¾·‡†,‚Ãœz˜±‡²V’†¼¼¼¼4½‡rð¾Ä©ÄËìÄ©Þ©Äì´€[«T¨â.š³~ÁÁ–%–\?m‹3 +†V‡ ±“"¼‡¾ËH--µË޾ɇŸV{@·W·¾É{rrrÉɾÞÆËžËìË©ÞèkÉÖ‡½†¼““j‡kÆØ›½‹‘ÿŪg–vÅ‘g‘ s ‘ÍÌZ~ÃÃ~‹Ã,“* ½E‡‡½‡½ý{—¡›û.cµ
¨:´¹G…;(&‡’¼zzz†š‡®5ž¨´GØØL›®{²’t†’½‡®ð”·”·ˆ1¾¤·”ðr½šU¼'““D†9h‡_”ð‡¼œqqõzF“±E’† + 3 Y“¼’‡rð·™ÆÄ©Ë©Þ(©Þ©ž[«T¨-ØuÎzÊÓ~~~~M¸Ã,Š½Vt“FŠ“’”Ë
GG-HË™·¾ðÖ‡Öð#··ˆÉ#rrÉÉ𔈛.žH..ìÄèˆk—½4“ŠÀ j/rÞ÷ãd,Ŭg>gí–¦ÌÅgs‘‘ ‘g ÅÌ–x‹‹¦‹qq³±tšt±˜õF''±š²{ðÞËž»´……«…¨cÞ¾É{½’¼¼±’½{ð¾ÄHT…»:H©”{½ ½{‡rk¾k”¤¾¤ˆˆˆˆ¾·”ð{{’’t±†*’½‡‡{®†FÃq³Fz˜±ßÕ‹Á 30 +±†½{ð”ÞÄËË웩ީžŒ…«ÂÂ…¨-ľ½†À¢ÃÊÊ, À““t²štD³qŠ’”ËØH¨¨»¨Œ;©™¾r®#”Þވ舡ððÉ¡Þ©ÆJcž.Ä›‡š˜z œz4¾Äã›*‚vÅvÿÑmÓÌÅ‘g‘‘‘ gÅÑ?ÁÓÁÁê~q,z˜±zœÒøê~wÊ,z†š‡®¡ˆì.Œ:»………»:J숡ð{{²’’š‡‡®iÞž
´¹=»-HÄð{’½‡ÖÖr””k”k”ˆˆˆ¾¾¾ð®{‡V’†Ut’’½‡{°‡ ŠœÀÀz'zÕwÁÌÅÅÌmÓÃœ“’‡{ɈÄÄûËÄìËžH¹ÂŽ[…-¨-}ˈr½"ÀÊœFzŠ¼±†*²*˜³,³U{·ËH}G|==¨.©ˆÉ®”èÞ™Þè¾iÉii¾ÄLJcHc©®ut¼zzz±Ö¤ÄÆðmÅ\>>íÓ‚Åvg‘s‘ggbÌ?xÁ?–ÁózÒ‚–mÅÅÅÅÌ̦~q¼’‡®¾Äž.Œ:¨¨T¨Hž.ËÞ›·ð®{‡{Öðèĵ»«ÂÂ[|-HÄ·ðuV²‡‡{_i”¡·¤ˆ¤·¾ið®{‡²’šUt†*Ÿ‡{{®{‡tDŠ˜zF“wxÅg‘ÅÅ–Áq³±’ŸÉ”™ÞËìËìžžŒ…ÂŽ•ÛŒ}
.Ä®’"³F††’’š±Fqq“½Þ.HT|•‰‰•Ž:µ›¤·”¾Þ™ÞÞÞè·¾i”¤¾1Þ©Ä.c.ËÄ·ð‡’t““¼†’܈ćʪvÌ\øÁ~¸ÌÅ‘g‘ g ÅÅÑÁ?–?–‹ÊœFœqÁíªÿgIggÅÅmÁ‚3À¼’ÖÉèÞ©žcùc.ù.ËìÄ›·r®®Ü¾©JŽŽ[¹-Ëð²½²{{®””i”¾·ˆ·¾¾Éð{‡½Všt†š ½‡{®{{u †±†t +zÀÓÌggggggíÁŠ’ÖÉÞÆ.ž.žHŒ-|ÂŽ€»HùH}÷ËÞ†'zz††š†±˜FqÃœ®ÞÄ.|¿ºy ¹Ä¾¾ÞÞÄ©Ä™Þ舡¾·ˆ™ÄËcµ.ġ𰽆t†t½°ÉˆL›ð±~ªÌ‹xª>êwqÑvgg‘ggvÑÑÑÑm?~Ê,Ê~Áªggssg‘ ÅÅíÌ–70À†½®ð¾ˆ›ˆ›ˆ›ˆ›ÆËËËÆÞˆ¾”k¾è©ù¨«Ž••!µ›”°²t½‡°_i·¾¡····”ð{{u½šš†±†*’‡Ö®®®®{½’D’zzzFÌ ¯‘ÍÍgggv¦Ê“’‡r¤©ãµH}}Œ»«ÂŽ•=.ì...Ëƈ®V± +“¼±DœÊqÃÀ’ˆÄH¨Â¿^pp)‰•ž1¾¾ˆÄ;Ë©ÄÞ™Þ興™ÞÄìËžHHË™·É{‡½½½V{ðiˆ›·z¦Å¦qxíMq~̪ggg‘Å ÅÌvv>v–‹Êœ,‚ÁªÅIsIss‘ªÅÅg<Ìê‚ “†½ýðÜð—É_”i¾nÆËËËeÞˆˆ™©Ëµ¨«Ž ¿¥ÛQHÄ·uVtš‡{ði¾¡··¾·¾”ðð{{½²½†D±†’½‡®ð®ð‡š’²’Àqů ‘‘sgggÅÌ‚Y¼’ÖˆÆ.}H-¨«[ŽŽ|-ìÄËËËÆ› {'z˜Šz“³Ê‚~3'‡ ˆÞc• yRpy¿¥¹µÞ·”·Þ;Ëù.Ä™›™ˆ›è›™Äì.HcžÄÞð®{‡‡‡{{ð®š3Áª~˜ÝqÁœ,‚ÑvÅggÅgÅvvv>v¦ÓÊ,ÃÁÅ‘‘g¯sss‘ s gÅgggÌ–‚,“t’u‡‡‡u‡{®ð›ËË...ËÄ©©ËcŒ…•‰‰•¹}Ĥ{š†’‡®Ü·ˆèˆè·¾®®{‡²’tt±±¼±Ut’E‡r””ðÉð{½½‡šz,œ~ÌgsÍ‘sÍ g Ågg–¢F’‡®™Hµ-¨T»«ÂÂ=THĈ¤ÞÞÞ›·{*˜FœFÀFFÊ‚~‚,“{”ˆÄ
=¿^yR•´.n”ð¾ˆ.cHJìÞÞÄÞ™ÞÞÄË.H.HHËÞ1”r®Ö‡{Ö{rÉððd‡±qÁmÒtÊwœ,‚Ñ\Åg‘Åbggvvv>vÁ~wÊ~–gsfss‘‘ ‘gÅÅÅgggíÁq³Ut½½š’½½½‡®¾nËË...ËËžùµ…Ž•‰¿¿ÛµÆ¾° †’‡®·èˆˆ·”®{‡½š†t±U˜D˜†½½‡®””ðÉ®‡‡{’³3ÊêÅ sssòs fgÅÅÿÅ‹3¼½rˆHH-¨»………}.™”””¾· °zÊÊ q,qq‹Á~œ"{(Þ
[¿º^yy^‰•}Æè®rðèJHcHÞÞ©ÞˆÞ™ÄìJµ.µ.©ˆˆðrÖ‡Ö{rÖð®°{EÀê¦ê,š°±,q,qvvÿÅÅÅÅvvvvv>í–‚Ã~–g‘Å‘¯¯sÍÍsg‘g g ggÅÅ–Mœ±t¼tt¼t½{ðÞÄ..ËË;žH¨…•¿¥¿!Â}Ĥ{Ÿ ŸÖ¾™Ä©ÄÄÞ¾ðr°Vš±D±˜˜˜¼±†š‡{r””è·k®{°½‚‹êssÍ‘‘ gbvgggÌÁ “‡ð›.HHŒH¨:»
.ĔɮÖ{®·C±,q‚~ÃÃË?¦~³D‡®ÉÞŒ[¿‰^^R^$«ž_{Ü·J:žËĈˆÞÞÄËË....Þ¡”rr{ÖÖrðÉðÖ{Vš¼qêÁq˜d²z,qÁ\Å>gg>Åvvvv>v]‹~Ó–Å‘g‘¯òsss‘ ‘g gggvÅ~œ˜±t±¼t¼’’{ð”ÄÄìËËË.µŒ´«Âl•¿ŽÂ¹GµÞ”ÖŸ‡ÉˆÄì.ìÄÞ¾ÉÖV½†±˜“˜“z“±¼t’‡{rˆ¾¾Þnˆ_{{’³‚ê~‹–‘‘‘ ‘bgÅ>gÌ7q“½®·ÞËž.HJcc;©ˆ¾ðr®Ÿ’’½@½'qM‹ê‹‚‹¦ÑÁ~œ"‡Ör(
«¿‰‰¿¿Ž…
žÞ·—‡{r”ËJHÄÞÞˆˆnÞÄÄÄËËnÞ¤”ÉrÖÖ{r®É®r{°*¼F¢‹¢³½d¼"ŠÊ]x̪ggÅ>vvvvª?¦~¦‹–Åg‘Ísòs g gg g g vgv–Óʳ'±U±¼±†t½{É·™ÄÄÄ©ÄìËžŒ-|«€ÂÛ[¹¨Ë¾Érrr”Þì.Hµ.›·®‡’’'˜FÀFz³zŠ'“t’½{®#¾ˆ™Ë.ì_½’³‹‹q,~‘gsÅÅ>gg>ÿÅg–qF†‡·ÄÄ.ËËÞ¾{‡{{‡UŠY¼*²³~êÁÁx–ÑÌ‹,z’VÖ¾ž•¿‰$[cľð{‡½o{kË.žËÞˆ1·ˆnÞÞÞÞ¾·É_ÖÖÖrðÉð”ð®t3‚êÀtd‡t“0Ã]–ÌÅÅvÌvvvÑ?‹~‚x¦–ÌÅ‘gssÍs g‘ g gggÅv–],³±tD¼±†’‡®”·ÞÞÞ™ˆ(ÄžH¹«|…»µË©¾”É”¾Ä.
}.©”Ö’†"Šœ0q,œœÀF˜“t ½{®¾ÞˆÄH}.¤®½¼qêê,E +Ê ÅbÅÅ>ÅÅÅ‘gªêŠ ‡É·ˆÞ™¾rŸ¼¼’½†Š3¢³¼*±qMm?–íÌÑÅvÌÓqF¼’Ÿ”ìTÂŽŽÂ…Œˆ{½š†’’‡ðÄËËÄ›ˆ¾”·¾·¾i”ðܮ֮—ðɾ¾›Þ›K®Dq~þ˜{›†"“Yœê–ÌÌÌvvÑÑx‚Ã3êÁ̪‘gs s‘g‘ggggÅ Å g>vÅÑ~qF˜U†††’’‡{𔾈ˆˆˆèˆ©Ëµ¨G´G¨.ËĈ·”¾¾Þì}HL›ðu±³œqw q¢Ã3,³À˜¼†½{®”·ÞÞÞì-}¡ý’“q¦~³uôt Ë‹Á–??–\̪ÅÅÅÅÌ‹3 +’{{®{½¼FÀ˜U¼,þÁq±ÒÁvÌvÅvv>ÑxÃœ'±’®ˆµTTŒJÞ”{’†±t†’‡ÉˆÆÞ·ð®ðð®ð®®{{‡‡ä{—ɾÞÆÆÆ›·{šq~7ÃqÀ²ÐÆ{†U¼'zõq~ê–vÅÑÑÑÓqFzFÒ‹íÅ‘‘‘‘ ‘gÅggÅ gÅ gÅvmÓʳ"t’’V²‡{rð¾¾¾ˆ¤¾¾™ÆžHH}Œcµùž©©ˆè¾ˆ¾ÞÄËHµ.ûÞ{’Š3‚¦x¦ê7~q,œŠ'¼t½{®ˆ›ËËÄÄ.G´}¾ä†Šqm~Õ²*t'Y,,ÊáqËx–ÌmÁ7À +¼U†˜Š3œÀ¼±Àê7ê,˜³Ã]Ñ\ÌÅvÅvgÑ–]ʳ“†ŸÉˆìµžÄ¾r4±“˜¼t’ÖÄÄ·ð®{‡{‡‡‡‡Ÿ½Ÿ‡Öð¾™ÄËÆ›‡tŠ~‹~qŠ{·›ðV¼"¼ó˜õ,q‹–?ÑÑ?ÊzU¼³‚Åÿ‘‘‘‘ ‘ggÅg>> Å Ågvg–‹œ¼ ½½‡{@®ð””·”¾¾¤·Þû.Hž..ìÄÄÞ™ˆ¾””·ˆˆËìËÄ1®’z ¸m\?xêÃqYz˜’²{®·ÞÆËHH.Ë}´µko¼Àqm~ÝtózÒ~‹~ÃÊáÕÕ'ݘDÕáÊÃÃ~ ‚Ã3,³'zFœ,'šEtʦ‹œÝzw]Ѭvg>Åv>vÑx¸,z“†‡—¾1¾Ü‡’¼"D'˜D†²{ˆ›ð{‡‡u½š’š½½½‡{Öi¾›ÞÆÞ¾®‡t˜œqqÃq +t’°·ÆÆ”‡U“"ó±D±'F,wxÑ\Ñqt ó‚ªsg‘‘g‘ÅgŬŠbgggÅÅ?‚zD½{{@®ð”¾¾”k”¾1ÞLËË©Þè(¤è¾¤”kÉ”ÞÆÞnˆi‡j 7¦ª\\\]Óq0z't*‡°®·ÆãHØ.H}»µ”ŸjÀ‚íM˜ózʦªÅ––M,Õ±²Eô*ÎD' Êqq0³ŠzFŠ±CðŠ~‚³±ÕÒÓÑÅ>g>v>vv~qzŠ“4½Ÿä‡’4j +À“˜†½{”®½¼¼±†t’t†’²‡{®ð”1ˆ¡””‡’“ ¢ êêœÀ“t’{_i··®½¼UV½t±U,Áv–œ½®0‘g>vg g‘gvîÅvvÅvvvv\Óœz’‡_ðð·É®ðɾˆÞÄ(ˆ¾¾ððð®®rð··¡d²Dœ‹Ñª>ÿÅm~qœ“¼’½‡®Éˆˆ©žµŒ´´T
¨´…Ëð‡˜ ~‹ÊÕ±³‚ÌgggÅÌ–êqzt²{rðÉð{{‡Ÿ†¼“zŠzŠŠ“½ð·šÀÀŠ¼¼Fq–vÅggvgÅ\ÅÌÁÃ,FŠD¼¼ +ÀFzz³˜±t’E{ðÚVÊÃqÊz˜±†’o‡{@Ú·d±õÒÃ~‹¦ê'±’²‡{{_ð·· ®‡ **’E‡‡²š±wÁ‹œ²ð#"–g>g>ÌÌÌvÅî>vÅvvvvvv–¸³±odi·ðr®””ˆˆ›ˆ¾É®{{°{{{ɾ_ušzqê–ÌÅvÌ–‹w³˜t½{{ð·›Äûì.}G´……»¨|}©r‡UÀÊ~FzqÁªg‘bgggÅÌÁqœz‡k·1¾¡¾ð®{½’t±“¼½›·‡¼Š¼’†qx\gvggv>gvíxêq,³ÀFŠz³³œ³³zz±†š‡{UÊ‹ÌÌ–‚Ê“±’²{{ý{°š'áqM]‹]‹‚ Ã0YšE°{°‡‡‡{_É·ð@{{{Ö{‡EDF,q0’·›V¢Åv––~ Á–ÌÌvvvvvv>vvvmót‡¡··É®rð”·ˆ”rrŸ*’²½{{®Éð{’¼zq7ígÅgÅÅ–Ãœ˜šud”Þ©ËžHc»»…=«Q…G…|H©ð‡†±qÊÂêÌÿg>gg Åg>ª\¦‚Š¼‡ð››Æ››·ð{²’’Ÿð‡†’½½†,¦ÑÅÿvg¬Å\>Å?‹ÃqÊÊœÊ ,qqœ³z˜"tVE ¼ –ÅgÅ‹Êz'tššš†¼,3~mÌÌ\–?‹‚wœz¼²‡u‡uo²o‡‡{ð·Þe›e+›¾ð{²²D³FF³†Æ@FíÅ\M~,œ~‹Á?Ñ?ÌvÅvvvÅ?‚š{è›·ðð®r{”¾ˆ®ÖVŸ’†šV²{{‡½†Š3þ¦míªgÿÅÅ–Mz½°·ˆ›ÄËH-G…QÂÂŽÂŽ€…|…GµÞ®Ö²’DF~xí\ª>gg>ÅvÅ>¬Å\7qŠ†{ð·ÞÆÆû›¡d‡‡V‡d·®½‡{{³‹\gÅggvgvÅ\–]~‚~‚‚ÃqqÊœ³z˜±šE†ÀÃÌÅgggvÁœF³³ ‚7mªÅg\Ì–Á]ʳ'U*’t±¼š’½o‡®¾›.H--Hì©”‡’³ÊFÀÀ†®›zÁí~œF±' +FÊÃMÓ¦?ÌÑvÌ\ví~Šš®·Þ™ðÖ{Ö{¾·ð‡½U4V²VV’"À7–ªÿgggÅÅÑ–ÃFu{ð¡ˆÞ©ËùHc¨»T…«ÂŽŽ€=|.èð{‡½*œÁgvvvÅvvvÑvÑŬvª\mÁ‚,“’{ð·ÆÆ›·rÖ½‡{{®{*z‹?Å>ÿ>Å>Å\Å?¦‹~‚~‚‹‹‚ qÊœF'˜’* +~ ÅggÌÁM‹Á–ÌgIfgggÅÅÌ–w,z't†š’'zFœ0³“±’½‡_”›.ØQ¹Q|´kŠ qŠ’{V³‹¸³'±U³ÊÒwê?–\ÑvÅÌؽðÞÆ·”®{‡{r”··ð{’U4¼UU š±Š <<g<gÿÿÿgÌ‹~F'š°®¾ˆÞÄË;HŒ:»…=ÂÂŽ€«»}ˤɮ{š,–¬ÿvvvÅÑÌ?–??Ì\Ìmê ³U’‡®ðÆƈ@{‡°_{®{{ z~\ÅgvgvÿvvÌ?ÁÓê‹ê~ê ~Ãqq,z˜Dš“ïsgÅÅggÅvŬgøggg‘gí?‹wœõ˜±D±U¼F,¢~‚~œ³“š‡®”èËHTQ••¹µ·¼þ¢Š†‡ruŠq¢q³'±tD˜'³F,œÊwÁx––Ѫ̂ +²É™Þ··É{‡ŸÖ®··ð{½t¼"""¼D'FÊ <Ps‘gÅÅgÅÑ–~,³¼š½‡o‡ÜɤˆˆÄ;ËcŒ¨»««ÂÂ=¹=|G}ˤ𮮰œ–gvÌÌ?–?Z~MÃqw~êêxÁx¦ê~3Y¼†Ÿð¾û.Lˆ®‡‡®ðð{r{‡*zÃxÅÿg>Å>Å\Ñmx¦‹‹‚‹‹‹‚ÃÊ,³'˜†DÊgfss‘Ågggg ggÅggÅ–‹F³õzzŠ³ŠzœÊË‹ê¢qÀ¼{_¾Äµ-…«Ž¿‰ÛG‡q +½rrš0‚Êz˜±'˜"zF³Fõ³ÊM¦?xÌÑÅê’®·ˆˆ¾É‡ŸV{r·¾ð{u’±¼" + +'œ~Ì<‘‘g‘ggÅÌÌ–MÃ,F³'¼š’’‡rÉɤˆ(©;Jc
»…«¹=|G¨}Ĥɮ®{ œÁÅ\Ì]Ó‹MÃÊFÕ³,œq‹M~‹‹~¢3À"†‡ðÞãH®‡‡u®®®{{‡*˜Ã]Ågvgvg\vÅÑ]ÁÓê‹ê‹~~ÃÊœzD±z Åg‘‘sfs‘‘gg ÅÅÌ?‹wqá³³Fœœ œ,0qq‹Áêê³±½ˆ™ËËŒ:…«•‰¿lG”¼À“rˆˆ±qþœÀ˜¼'zFq,œ,³'³,q‹‹¦?ÿÅÁÀ*®¾É®‡V‡ÖÉð‡’t±z +¼'FÖÅg‘s‘ÍgggÅvÅÑ–x~~~ÃqÀz“††½½{®ðð¡ˆÞ©ìccŒ¨»…-.©¾·_®{t0‹mÁ‚Ê0Ê,YF +z"±U±“D'z,qÊ30 ÀA“’ÖiÄ.Ë{½½{®{‡‡½zÃxgggÿ>Å>v\Áx]Á]‹ê‹~ÃÊœ,zU± +Ãmgs‘ ssÍsͯss ‘ Åbg>Ñ?‹MÃÊqÃqqq œœY³ÊÊ‚‹êÁqz’®¾Þì.ŒŒ»«Ž¿¿Û·UÀ¼©ˆt¢qÀ±U±z³qÃqÃq,zzÊMêӖѪÁq¼{¾¾”r‡‡‡{rðu’t¼˜ +"qÁÅÅÅs‘Í‘g‘ gÅgÅÅÑ––x¦~‚Ê3³Š¼††’½{®Ü¤ˆ©Äìcc:T-žÞ¤¾ð®{t³‹–Ã0˜'“'Ut ’ ’’ó'³FÀ +Š"4’{”Äa®²½‡{®Ö‡’±0]–ªgvÅvÅ\ÅÑ–]ÁÁ]ÁÁÁ~ÃÊ,z'˜',~gg‘s¯ss‘‘ss gb bvÌÁx‹M~w‚~qÊqœ œŠ +³,qw~]Ãœ¼u”›.c
¨»Â•lÛG†Š’ÄHè˜ U½’UÀÃ~]x¦Mq,z³q~‹]ÌÅm~’®rÖ‡‡‡rððð‡š†±z"³Ê‹ÌgggsssÍ Åb>ÅvgvÅ\ÅÑ–¦‹qÊœzz˜tš’‡{{𡈙Æìãµ.숷”®{ ³Ã‚À“ ’ ’’½½‡Ö{{‡‡uE’¼"¼¼¼4 Ÿ{®ÞÞ®‡½‡‡®{‡’"œ‹mÅÅÅÅ>Å>vvÑ\?í?m?Áx~~ÊœŠ³êÌggòsBs ‘ÍsÍs ‘ ÅbÌ??xxÁÁ‹ê~‚q,œY³Š +zF,¸~‚,¼²ÉˆìËccŒ¨«ÂÛ«ØW4"‡.ˆ˜œŠ½{‡¼Ã‚Á\Ì–‚ÊF˜'œÃ‹xÁvÌmʼu®®”ððr‡‡‡‡®ðð{š†˜˜Y~–ggÍs s‘ÅbÅg>ÅvÅvÅvªÑmÁêq0³“±†š²‡‡®ð¾1Þ©µ.ì.ËÄ辡ɮ{ŠqÃ" u½‡Ör{®®rrd{½½½VŸV‡‡Ö®Üðˆ·ð‡‡½½®Ö‡’¼F‚xÅÌvÌvÅ\v\ÅÑÌv\Ñm?Á‹‚ÊÊFzYœÊ‹Ìgg‘‘s‘‘‘ss‘Í‘g‘b ÅÑ?xx–?mÓê~q0³ÀzŠŠŠz³áw‚z ®Ä.H::…«¹ð†Ur5U“ ð#‡"þ‹v\vÑÁà ˜'zÊqÓ]Ì\–ê³uuððð®Ö‡Ÿ½{ð𮽚¼˜ŠÊ‚ÌÅ‘sssÍ Åb>ggv\>vªvÑ–]ÁÓÃq,³'±D’š½‡{®ð”ˆËÄÄÄ©Þè¾É®‡tŠF³¼š{{‡‡‡{{®®ÉÉð”ð·ð®®r{r®É®®®®®¾ð‡‡‡½Ö{{ zÃêÌ–íÌÑ–ÑÌv\v\>Å\–?ÁÓ~qqqFœ0œêÌÅg‘ s ‘ÍsÍg‘g ÅÅÅÅÑÑ?––ÁêÃqFz'“““'˜õœ~w0˜‡”Ä.c-¨´…´µˆ‡†’¾µk’Er·#Ö"7x–\vÅvm‹q +±'³Êw~]?íxq³±t½‡{{{ŸVŸ‡ðð°’t¼zÊ‹íÅggssÍ‘s Å Ågª>g>ÿ>>v\Ñ–xê~Êq,œz˜†’½‡{rði¾ÞÞ™Þ™Þˆè”_{½¼³0³²®u‡{{®rðð”·¾ˆˆ·¾·¾¾·ð{{‡Örðru‡‡½‡‡Ö{‡DœMÁÁ?Á\ÌÑ\vÑv¬g\Ñ–Ó~wqÊÊœ ³Fœ,~Á–bÅ Í‘g‘g‘ ÅÅÅÌÑ?Ì?–‹‹q,˜U±4¼¼¼D±ÕõwwÃF¼ˆˆ.HH}.Þð½4Æ-µk@®a¾Ö + ê?vv\>ÌÁ¢ÀD¼ózá~M]xÁqœ³“†½‡{½½‡·ð‡š±'3ÁÅÿgg‘‘s ‘‘ b>gvÿvv\Ñ\Ñ?xxxMMÊ,,FŠ'¼t’V‡{r®É”¾¾ˆˆÞ™ˆ·”ð{½˜ÀFz†u°u‡u{{®ð_·›Ä©ÄÄËÄÄěޛ·ð{²½’Ö‡½‡½½‡‡rð@u˜ÊÊÃ~ÓÁ–Ñ\Ñv¬ví?]~œõzŠzŠ˜"˜œÊMÓÌgg ÅggÅgvvvv??–¦‹‚ÊF“DD 4¼±tDÕ³áÃq“VÖ”aaJË;ìˆkr† žGµ¤a.WÖ“þ‹Ñ\>vÅÌà ¼t'Fww]ÁÁ¸q Š†½‡‡‡½{››d½†'œ–ÿggg‘ ‘‘ s ggŬgvÌxÓ?]xxÓMwÊ,³''U’½‡‡Ö®Éð””¾ˆ™ˆ¤”k®‡’“ œt½u‡š‡o{_®ði”1ÞÆ©Ë.žãµãžËÄ_‡’†U’½½½½½½Ÿ‡®ð°CDáÊwM?v\ÅvÑ]ÃáÕ±±±“˜D±tDÝáÙ?ÌÅÅggg>ÅvÅvÑ?x?–xê~,F'’’4 †¼"3¢~ q +*”ˆˆ›ˆ‡†£’1´ž™H.›‡Š3q‚¦Ì\v\vꜘ’²š˜ qqÊ‚M]ÓÓ‚Êz†½{Ö‡®·ÆÆÜÖŸ'Ê–gg‘g‘‘ÍsgÅÅÅvÌmÁ‚q‚qê‹ê‹¸~MqÃ,³À˜±Dt*²u{{rr®¾ˆ·ð®{‡¼FœF“š’½²½½‡{{rɾˆÞ™ÆL.žHHJHµËÞ·ð°t˜“¼U†š²½²‡‡‡Ö”¾¾””É{Ö‡¼À¢‹mªª>\\Ó3À¼‡ÖÉrrÖ’“UDD±D˜œ‹–ÌÌÅgg>>vvÑ?–?–\?]xêw³˜¼††’/ 4 ’V†¼ 7¦"‡Ö#rÉ®½†£’Ü´´µ.
.‡“³Š ‚Á¦ÑÑv¦¢z†u‡o±z³œqwMM~qzU½@{‡{›Æ›ÖŸDáÁggg Í‘g g‘ÅÅv?~wqFÀF Ê‚ê]ÁÓêÓÃq,0F“'±t*²½Örr¾ˆ·É{{*“œ ³'†š*’’’‡{Ö®ð”¾èÞ©ÄìË.ž.ùËÞèð‡ç˜ +Š“±†t’9‡‡Ö®É¾W¾Þˆ¾{’Uq‚?íѪx]À“½ðˆ›ÞÞ”‡“ŠY³'DšštD³q ¦ÌÌÅgvÑ?m?–?Á]~qF˜Ut ’½’VŸ‡’’Uzqê–¦~q +±ttt†“z¼‡û-´-}G-H‡±¼†±À3~¦?Ѧ~3±‡d{t¼z³Fœáqqœ"†{𮽽°1›¡r‡œÁgg‘ggs Å‘ÅgÅÌÁ~œ'š’t˜ÀÊ‚Ó¦??]Ó~qÃqF³˜±’Ö{ð””·É®½†ÀÊqFzt±¼±’½{{®—ð”·¾¾nÞ©ÄÄ™ÞÞˆð®ut˜Àz“˜˜¼±’o‡®ðÉ”ˆÄÄÄÞ›¾®‡¼Y¢‚‹¦‚Ê“†‡ÄLHHÆrU3~êÊõ±Î²²˜œq‹¦–̪ÑÌ?–xm?–]‹wqz'††’ VŸ½‡{{‡š†F¢‹Áê‹qÊÀ³À³z“oµ|-¨Ta¾®½½u{‡±z,‚Ó] êqz½ð°²D˜z'z'˜†½®#®½“¼½®··É—*ÕÁggggÍ‘bggg–ÁÃFD²d² ±œ‚Á?\ÌѦÁê~~qᜳ˜U4’½Ö®r®r{‡‡’' qʳ˜˜Š˜“t½{Ö®®ÉðÉ”k”¾k¾¾¾¾”Éðd½t±"“z“zŠzñ¼š½{Ö®”¾ˆˆÞÞ®{½tU˜˜'t’½{ðÄË.¾†mÅÌÓʳD²EšDŠ,Êq‹x‹ÓÓê‹x–?‹¸q³±†*’’½½‡‡®{d{°½t“œqꦦ]‚wq³¼²ÆQ………-.®½’‡ðð‡†“Fq~‚‚³š{··ð‡’t¼±¼t’ ½®É{’ q³’®ð®*z‹Åggg ggggÑ‹Ò +t½@®®{’±,‚xmÑvvÑÌ?–Áê‹ÓwÊÒ,œY +“4V‡Ö{Ÿ ¼³qq,³FÀFÀ'’‡°{®®®r®—®®®_®rrr_É®®®‡ušttt±zŠ³“£½‡{®”·”¾ˆÞ›¾K·K·@ðððððɾ·ˆÉš –I>\–ê,±*² t±ŠFœqqœqÊq~ê¦Áê~,³˜Ut†’E½½‡{dðððd{²±Fq¸qÒ³±uµâ|¹=…Tar½’š®··ð{E¼FqÃq,¼²û›·®‡½’’ š½V®r{† þ7³‡_É®E‹ÅÅg ggÅggÌÓœ*ð· ð{V†³Ã]–\v¬vvÌíÌ?m–Áêê ¢ “ Ÿ{Ö‡’¼ +qqÊqœ,qqq³“t½‡{{‡{Ö‡‡½ä‡‡‡‡Ÿ‡Ÿ‡‡‡½ššštE½E½š†˜Š˜˜†’½‡{®”·ˆ›Þ›ÞÆ›ÄÆÆÆðr®rÉ®‡†Fêv>ÿvêʘ*²E’*t¼˜˜˜˜FáqM‹]~w³zUt†’’’‡{®ð····ð{‡†¼˜z˜†½dãö|=…Tcð’“¼’ð1ÞÞ¾É{‡†± +, FŠ¼‡ð›ÆL›É®ru‡‡‡ÖÖ‡’Àêmq’°®®š~ÌÅÅgÅÅv–MœÝt{@ð”𮇆'3‹ÑvvvvvÅÅÅÌÑÑ\Ñ–¦7 ¼’{‡ŠœÃqÃÒwê‹œ'šV²‡½‡½½½’’’†’††††¼±"±˜D± ²C{du½š£±††½‡½‡{®®®®ð”·ÞˆÆˆ·k”Ür—{½†³ÃvvgÿŦÊzš²‡u½²’’†’±'³Ê‚ÃqœF˜˜††’’½o{_···ðð®{°°ûØ×´|T|Tµ”Š Š²ð›Ä›ˆ¾#®½DzFÀz†®¡ÆãH.›ˆˆðððÖÖŸ’±þ<qt‡®ð*¸ÌÅÅgggÅÌÓÊÝš*{@”@” É{‡’˜œ¸–ѬvvªvÅÅÅ\Å\Å>ª–Ã3“’‡®r{’“³‚qqw~mÁ꜓*½²V²½’’†¼¼¼¼¼“¼“¼“ŠŠÀ,³˜'š*{ðd‡uo½o‡{‡½’h†ç†† Ÿ{{Ö®ÉðÉ”ˆ·¾É®‡†zÊ]v¬vg>Åê,“*u{°‡‡²‡9*tœÃq,œŠ'¼tt†’Ÿ‡ÖrÉiˆ™ÄÄìÄÄ©Æ©ÄÞË.-GG|GµË¤¼q ˜½nËìÄÞ¾”®®‡ ¼Š“¼’ܾ©.HH.ËÆ·ðÖÖ‡VŸq‚q“u®‡z~ÁÑÅ>ÅÑ–]ʳ±²°®É¾”ðr{{ zwÁÑvvvÑÌm–mÁ?m?¦‹œ˜‡{É@{’UŠÊþ~qÊÒÓ]ÅÁqFDtt*t¼±"±“Šz˜˜“À,œ,0³,q~ʳF'šðð{{{®ð_ðð®uh±“jŠŠ““†’½‡‡‡r¾™Ä©ÄĈ𽓂?vŪg\Åêq±’u{°_{{u*±³ ³Yz“¼†††š’VŸ{Öð”¾ÞnÄ.L..HH
-:G:G´GžË¤®†Y3 ±‡i›ÄÄĈ¾”ð@d{š¼ç†Ö_·ÄìË˲ɮÖÖ‡½½ŠqÀ±‡{½DFÃÁ–ÅÅÌ?‹‚á˜Îu°r@”Ér®Ö{†œÃ]Ñ\ÑÑ–x‹~~~¸~¸³'š®@®{½UÀ qqÃq,w¦?Ŧó'±D±“z +³ÀzY³ +³0œ Ê3qqÊêÁ–]‹Ê0±E®_®_ð·id_‡‡’’’’½Ÿ‡Ö‡Öð¤ÆËË.ìƈ°’zwÓÌvgŪ–‚Ft’u{{{{²z +³ +z¼Ut†t†††’Ÿ‡ÖrÉ·ˆÞÞìËHµ}:»T»T¨
Œ.ì›·‡†Šœqz’ðˆÄì©ÞÞˆ·W·#®‡½††o‡r¾ˆÞÄÞ›·®rr{‡{±z±’°{’œ~]Á?–x‹Ã,z±šu°®®ÉðÉ®r{‡†zqÃÁ??\x‚qYzŠzz˜±tu{d°t“,q~qFœw?\ÌÁÃFzFFœ,qÊq,œœ,qÂ~‚ÃÃÃ~ÁÌvÅ>ÅÁ~œ'½d·¡·”_Ék¾¡ûÆûÆû›1¾É®Ö{Ö{É·ˆÄìHµH©·‡³qx–ÌÌÑÅ\Á‚z±šu‡°{{u½†'“““¼¼’’ ††t†4VŸ‡®r”¾¤ˆÞË;.cŒ
:::
HJË©Þ¾_’ñ,À +t{nÄËùËÄÞ››ˆr‡½4Ÿ‡É”¾ˆ·r®rr®Ö°††šV®¼ÊqÓ‹ÁÁx‹q,zDš²u°r®r®r®r{‡† +œwê??x]Ê't *Vtš*²°d{š’±"³q~q,zõ¸–v–êá³F,qÊq~‚‚Ãq3,qÃêÁê~~ê‹Å¬ÅgÅ>ª–~Ft{𷈤·¤··ˆÆLãö´öØLƾð®Éi¾1ÞËžHµ®²˜Ê¸Á]––mÌ\Áʳ˜’²o½½EšU±¼†’’½’’†††’ ½‡{®ðɾˆÞÄËì.JùHcž©Þ™¾_{’˜³ Št‡ËÄùJùJ;ÄÄÄÞÞÞľ_{‡½‡‡‡{®rd{rð®®{²*²‡®‡“~‹mÁÓ‹~wʳ˜t’½‡‡®®®®®Ö{{‡†˜,æ??¦Ãzš®®{uVu²u²½’±±z³,qqÃqFFÃÅ?~,õ,qM~êÁ¦‹êÃÃq~]ÁÓMM]?xÌ>>vvvÅŦʓV®iˆ™ÄËÄ©Ä©;Ë}G¹!l!¹H©ˆ¾k·¾·èˆ©ÄžHìÞð¼,q‹‹‹xÁÑÌêó˜±t†š†D¼U†’½’½V‡½’†t¼¼†† ’½Ÿ‡®Ü¾¤ˆÞ©ËÄ©ˆ(¾”¾”®‡²¼Š³À'‡dÆìJJùJJìËÄÞÞÞÄ©›ˆ¡®Ö‡‡‡‡u‡Ÿ‡{ÉðÉ°½‡u‡®VÀ¦–ÌÁÓ‚œ"t’½½o{{®®Ö{‡½½†Yœ¸Á?–Mœ±ðð@®uuu½š†“³qÊqqÃþÃœ˜³MÁÁw,³~Á]Á?–¦‹‚‚~¦Á?Áê‹?–?ÑÅ>Åvg>>Å–~À’{Éĵ}}Œ»€!l¥!¹-Ë™¾¤·ˆèÞÞ™.ˈ{ zÊ~~‹‹]ÌíѦÓqF³Š˜"zŠ“’‡‡{‡‡’†¼¼z'“±U±’’‡{®ð”·¾11·ið—®_{‡½†Š³z“Vðú›.ìJùccHJžã;©ÄûÄn¡®{ŸV’Vhš’½Öð{{‡{’0̪vÌÁ]Ê,³±†’’oŸ{{{‡o††“³qæxÓq³’¾K”®{‡½š’tŠÀœwq~qÃq‹q,z'FqÓ‹~FõÊ‚xÁm?mxêÓ‹]?–]?xx??ÑÑvvvvÅÅÑ–~À{܈컅==……ÂÂŽ[}ˈ¾¤ˆ¾èˆ™(™(™ˆ¾”®’"œÃ~‹~MÁx?–xê~Ãq,, 0 "½{r®r®{‡’¼˜Šz˜Šz“¼¼†½½ä{—ð_ð®—{Ö‡Ÿ’’jzŠt½d›ÆžËùJJc
µc.Ë©Ä©Äû·ð{½ ’t††½_É”®°{°‡ Oí>gª?‹Ã,z±†’’Ÿ‡uo{{‡½††¼ŠFq~‹x‹q'½ ˆ®{‡’š†±À M]¦ÓqqÂʜ'³Ã‹qFÕ,w‹‚?Á¦Ó~‚‹¦?–?¦x–?xÑÌÑ?ÑÌÑÑvÌm~œ†ÖðèÄŒG¹QŽÂ«=«[Â[Â=JÄè¾¾¾èÞÞÞ™(™¾k”É{’' ÃÃwÃw~ÓêÑÁ‹‚~qq “V®ðr@É®‡’“Š
\ No newline at end of file diff --git a/packages/ptc/src/aread.inc b/packages/ptc/src/aread.inc new file mode 100644 index 0000000000..0833f8642f --- /dev/null +++ b/packages/ptc/src/aread.inc @@ -0,0 +1,39 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCArea=Class(TObject) + Private + FLeft, FTop, FRight, FBottom : Integer; + Function GetWidth : Integer; + Function GetHeight : Integer; + Public + Constructor Create; + Constructor Create(ALeft, ATop, ARight, ABottom : Integer); + Constructor Create(Const AArea : TPTCArea); + Procedure Assign(Const AArea : TPTCArea); + Function Equals(Const AArea : TPTCArea) : Boolean; + Property Left : Integer Read FLeft; + Property Top : Integer Read FTop; + Property Right : Integer Read FRight; + Property Bottom : Integer Read FBottom; + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + End; diff --git a/packages/ptc/src/areai.inc b/packages/ptc/src/areai.inc new file mode 100644 index 0000000000..205b274072 --- /dev/null +++ b/packages/ptc/src/areai.inc @@ -0,0 +1,92 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCArea.Create(ALeft, ATop, ARight, ABottom : Integer); + +Begin + If ALeft < ARight Then + Begin + FLeft := ALeft; + FRight := ARight; + End + Else + Begin + FLeft := ARight; + FRight := ALeft; + End; + If ATop < ABottom Then + Begin + FTop := ATop; + FBottom := ABottom; + End + Else + Begin + FTop := ABottom; + FBottom := ATop; + End; +End; + +Constructor TPTCArea.Create; + +Begin + FLeft := 0; + FRight := 0; + FTop := 0; + FBottom := 0; +End; + +Constructor TPTCArea.Create(Const AArea : TPTCArea); + +Begin + FLeft := AArea.FLeft; + FTop := AArea.FTop; + FRight := AArea.FRight; + FBottom := AArea.FBottom; +End; + +Procedure TPTCArea.Assign(Const AArea : TPTCArea); + +Begin + FLeft := AArea.FLeft; + FTop := AArea.FTop; + FRight := AArea.FRight; + FBottom := AArea.FBottom; +End; + +Function TPTCArea.Equals(Const AArea : TPTCArea) : Boolean; + +Begin + Result := (FLeft = AArea.FLeft) And + (FTop = AArea.FTop) And + (FRight = AArea.FRight) And + (FBottom = AArea.FBottom); +End; + +Function TPTCArea.GetWidth : Integer; + +Begin + Result := FRight - FLeft; +End; + +Function TPTCArea.GetHeight : Integer; + +Begin + Result := FBottom - FTop; +End; diff --git a/packages/ptc/src/baseconsoled.inc b/packages/ptc/src/baseconsoled.inc new file mode 100644 index 0000000000..6e655cb910 --- /dev/null +++ b/packages/ptc/src/baseconsoled.inc @@ -0,0 +1,61 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCBaseConsole=Class(TPTCBaseSurface) + Private + FReleaseEnabled : Boolean; + Function GetPages : Integer; Virtual; Abstract; + Function GetName : String; Virtual; Abstract; + Function GetTitle : String; Virtual; Abstract; + Function GetInformation : String; Virtual; Abstract; + Public + Constructor Create; Virtual; + Procedure Configure(Const AFileName : String); Virtual; Abstract; + Function Modes : PPTCMode; Virtual; Abstract; + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Virtual; Abstract; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Virtual; Abstract; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Virtual; Abstract; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Virtual; Abstract; + Procedure Close; Virtual; Abstract; + Procedure Flush; Virtual; Abstract; + Procedure Finish; Virtual; Abstract; + Procedure Update; Virtual; Abstract; + Procedure Update(Const AArea : TPTCArea); Virtual; Abstract; + + { event handling } + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Virtual; Abstract; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract; + + { key handling } + Function KeyPressed : Boolean; + Function PeekKey(Var AKey : TPTCKeyEvent) : Boolean; + Procedure ReadKey(Var AKey : TPTCKeyEvent); + Procedure ReadKey; + Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled; + + Property Pages : Integer Read GetPages; + Property Name : String Read GetName; + Property Title : String Read GetTitle; + Property Information : String Read GetInformation; + End; diff --git a/packages/ptc/src/baseconsolei.inc b/packages/ptc/src/baseconsolei.inc new file mode 100644 index 0000000000..311c9a5e29 --- /dev/null +++ b/packages/ptc/src/baseconsolei.inc @@ -0,0 +1,88 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCBaseConsole.Create; + +Begin + FReleaseEnabled := False; +End; + +Function TPTCBaseConsole.KeyPressed : Boolean; + +Var + k, kpeek : TPTCEvent; + +Begin + k := Nil; + Try + Repeat + kpeek := PeekEvent(False, [PTCKeyEvent]); + If kpeek = Nil Then + Exit(False); + If FReleaseEnabled Or (kpeek As TPTCKeyEvent).Press Then + Exit(True); + NextEvent(k, False, [PTCKeyEvent]); + Until False; + Finally + k.Free; + End; +End; + +Procedure TPTCBaseConsole.ReadKey(Var AKey : TPTCKeyEvent); + +Var + ev : TPTCEvent; + +Begin + ev := AKey; + Try + Repeat + NextEvent(ev, True, [PTCKeyEvent]); + Until FReleaseEnabled Or (ev As TPTCKeyEvent).Press; + Finally + AKey := ev As TPTCKeyEvent; + End; +End; + +Function TPTCBaseConsole.PeekKey(Var AKey : TPTCKeyEvent) : Boolean; + +Begin + If KeyPressed Then + Begin + ReadKey(AKey); + Result := True; + End + Else + Result := False; +End; + +Procedure TPTCBaseConsole.ReadKey; + +Var + k : TPTCKeyEvent; + +Begin + k := TPTCKeyEvent.Create; + Try + ReadKey(k); + Finally + k.Free; + End; +End; diff --git a/packages/ptc/src/basesurfaced.inc b/packages/ptc/src/basesurfaced.inc new file mode 100644 index 0000000000..84d4dd2986 --- /dev/null +++ b/packages/ptc/src/basesurfaced.inc @@ -0,0 +1,67 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCBaseSurface=Class(TObject) + Private + Function GetWidth : Integer; Virtual; Abstract; + Function GetHeight : Integer; Virtual; Abstract; + Function GetPitch : Integer; Virtual; Abstract; + Function GetArea : TPTCArea; Virtual; Abstract; + Function GetFormat : TPTCFormat; Virtual; Abstract; + Public + Procedure Copy(Var ASurface : TPTCBaseSurface); Virtual; Abstract; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Virtual; Abstract; + Function Lock : Pointer; Virtual; Abstract; + Procedure Unlock; Virtual; Abstract; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Virtual; Abstract; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; Abstract; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Virtual; Abstract; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; Abstract; + Procedure Clear; Virtual; Abstract; + Procedure Clear(Const AColor : TPTCColor); Virtual; Abstract; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Virtual; Abstract; + Procedure Palette(Const APalette : TPTCPalette); Virtual; Abstract; + Procedure Clip(Const AArea : TPTCArea); Virtual; Abstract; + Function Option(Const AOption : String) : Boolean; Virtual; Abstract; + Function Clip : TPTCArea; Virtual; Abstract; + Function Palette : TPTCPalette; Virtual; Abstract; + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + Property Pitch : Integer Read GetPitch; + Property Area : TPTCArea Read GetArea; + Property Format : TPTCFormat Read GetFormat; + End; diff --git a/packages/ptc/src/basesurfacei.inc b/packages/ptc/src/basesurfacei.inc new file mode 100644 index 0000000000..6b50bdd5b8 --- /dev/null +++ b/packages/ptc/src/basesurfacei.inc @@ -0,0 +1,19 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} diff --git a/packages/ptc/src/c_api/area.inc b/packages/ptc/src/c_api/area.inc new file mode 100644 index 0000000000..eca3130933 --- /dev/null +++ b/packages/ptc/src/c_api/area.inc @@ -0,0 +1,140 @@ +Function ptc_area_create(left, top, right, bottom : Integer) : TPTC_AREA; + +Begin + Try + ptc_area_create := TPTC_AREA(TPTCArea.Create(left, top, right, bottom)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_create := Nil; + End; + End; +End; + +Procedure ptc_area_destroy(obj : TPTC_AREA); + +Begin + If obj = Nil Then + Exit; + Try + TPTCArea(obj).Destroy; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + End; + End; +End; + +Function ptc_area_left(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_left := TPTCArea(obj).left; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_left := 0; + End; + End; +End; + +Function ptc_area_top(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_top := TPTCArea(obj).top; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_top := 0; + End; + End; +End; + +Function ptc_area_right(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_right := TPTCArea(obj).right; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_right := 0; + End; + End; +End; + +Function ptc_area_bottom(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_bottom := TPTCArea(obj).bottom; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_bottom := 0; + End; + End; +End; + +Function ptc_area_width(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_width := TPTCArea(obj).width; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_width := 0; + End; + End; +End; + +Function ptc_area_height(obj : TPTC_AREA) : Integer; + +Begin + Try + ptc_area_height := TPTCArea(obj).height; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_height := 0; + End; + End; +End; + +Procedure ptc_area_assign(obj, area : TPTC_AREA); + +Begin + Try + TPTCArea(obj).ASSign(TPTCArea(area)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + End; + End; +End; + +Function ptc_area_equals(obj, area : TPTC_AREA) : Boolean; + +Begin + Try + ptc_area_equals := TPTCArea(obj).Equals(TPTCArea(area)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_area_equals := False; + End; + End; +End; + diff --git a/packages/ptc/src/c_api/aread.inc b/packages/ptc/src/c_api/aread.inc new file mode 100644 index 0000000000..2703b9146a --- /dev/null +++ b/packages/ptc/src/c_api/aread.inc @@ -0,0 +1,15 @@ +{ setup } +Function ptc_area_create(left, top, right, bottom : Integer) : TPTC_AREA; +Procedure ptc_area_destroy(obj : TPTC_AREA); + +{ data access } +Function ptc_area_left(obj : TPTC_AREA) : Integer; +Function ptc_area_top(obj : TPTC_AREA) : Integer; +Function ptc_area_right(obj : TPTC_AREA) : Integer; +Function ptc_area_bottom(obj : TPTC_AREA) : Integer; +Function ptc_area_width(obj : TPTC_AREA) : Integer; +Function ptc_area_height(obj : TPTC_AREA) : Integer; + +{ operators } +Procedure ptc_area_assign(obj, area : TPTC_AREA); +Function ptc_area_equals(obj, area : TPTC_AREA) : Boolean; diff --git a/packages/ptc/src/c_api/clear.inc b/packages/ptc/src/c_api/clear.inc new file mode 100644 index 0000000000..9d287d9e87 --- /dev/null +++ b/packages/ptc/src/c_api/clear.inc @@ -0,0 +1,48 @@ +Function ptc_clear_create : TPTC_CLEAR; + +Begin + Try + ptc_clear_create := TPTC_CLEAR(TPTCClear.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_clear_create := Nil; + End; + End; +End; + +Procedure ptc_clear_destroy(obj : TPTC_CLEAR); + +Begin + If obj = Nil Then + Exit; + Try + TPTCClear(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_clear_request(obj : TPTC_CLEAR; format : TPTC_FORMAT); + +Begin + Try + TPTCClear(obj).request(TPTCFormat(format)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_clear_clear(obj : TPTC_CLEAR; pixels : Pointer; x, y, width, height, pitch : Integer; color : TPTC_COLOR); + +Begin + Try + TPTCClear(obj).clear(pixels, x, y, width, height, pitch, TPTCColor(color)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; diff --git a/packages/ptc/src/c_api/cleard.inc b/packages/ptc/src/c_api/cleard.inc new file mode 100644 index 0000000000..4f8f761bdc --- /dev/null +++ b/packages/ptc/src/c_api/cleard.inc @@ -0,0 +1,9 @@ +{ setup } +Function ptc_clear_create : TPTC_CLEAR; +Procedure ptc_clear_destroy(obj : TPTC_CLEAR); + +{ request clear } +Procedure ptc_clear_request(obj : TPTC_CLEAR; format : TPTC_FORMAT); + +{ clear pixels } +Procedure ptc_clear_clear(obj : TPTC_CLEAR; pixels : Pointer; x, y, width, height, pitch : Integer; color : TPTC_COLOR); diff --git a/packages/ptc/src/c_api/clipper.inc b/packages/ptc/src/c_api/clipper.inc new file mode 100644 index 0000000000..4246034375 --- /dev/null +++ b/packages/ptc/src/c_api/clipper.inc @@ -0,0 +1,33 @@ +Procedure ptc_clipper_clip(area, clip, clipped : TPTC_AREA); + +Var + tmp : TPTCArea; + +Begin + Try + tmp := TPTCClipper.clip(TPTCArea(area), TPTCArea(clip)); + Try + TPTCArea(clipped).ASSign(tmp); + Finally + tmp.Destroy; + End; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + End; + End; +End; + +Procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination : TPTC_AREA); + +Begin + Try + TPTCClipper.clip(TPTCArea(source), TPTCArea(clip_source), TPTCArea(clipped_source), TPTCArea(destination), TPTCArea(clip_destination), TPTCArea(clipped_destination)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + End; + End; +End; diff --git a/packages/ptc/src/c_api/clipperd.inc b/packages/ptc/src/c_api/clipperd.inc new file mode 100644 index 0000000000..29642abaa6 --- /dev/null +++ b/packages/ptc/src/c_api/clipperd.inc @@ -0,0 +1,5 @@ +{ clip a single area against clip area } +Procedure ptc_clipper_clip(area, clip, clipped : TPTC_AREA); + +{ clip source and destination areas against source and destination clip areas } +Procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination : TPTC_AREA); diff --git a/packages/ptc/src/c_api/color.inc b/packages/ptc/src/c_api/color.inc new file mode 100644 index 0000000000..966dee2286 --- /dev/null +++ b/packages/ptc/src/c_api/color.inc @@ -0,0 +1,177 @@ +Function ptc_color_create : TPTC_COLOR; + +Begin + Try + ptc_color_create := TPTC_COLOR(TPTCColor.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_create := Nil; + End; + End; +End; + +Function ptc_color_create_indexed(index : Integer) : TPTC_COLOR; + +Begin + Try + ptc_color_create_indexed := TPTC_COLOR(TPTCColor.Create(index)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_create_indexed := Nil; + End; + End; +End; + +Function ptc_color_create_direct(r, g, b, a : Single) : TPTC_COLOR; + +Begin + Try + ptc_color_create_direct := TPTC_COLOR(TPTCColor.Create(r, g, b, a)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_create_direct := Nil; + End; + End; +End; + +Procedure ptc_color_destroy(obj : TPTC_COLOR); + +Begin + If obj = Nil Then + Exit; + Try + TPTCColor(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_color_index(obj : TPTC_COLOR) : Integer; + +Begin + Try + ptc_color_index := TPTCColor(obj).index; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_index := 0; + End; + End; +End; + +Function ptc_color_r(obj : TPTC_COLOR) : Single; + +Begin + Try + ptc_color_r := TPTCColor(obj).r; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_r := 0; + End; + End; +End; + +Function ptc_color_g(obj : TPTC_COLOR) : Single; + +Begin + Try + ptc_color_g := TPTCColor(obj).g; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_g := 0; + End; + End; +End; + +Function ptc_color_b(obj : TPTC_COLOR) : Single; + +Begin + Try + ptc_color_b := TPTCColor(obj).b; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_b := 0; + End; + End; +End; + +Function ptc_color_a(obj : TPTC_COLOR) : Single; + +Begin + Try + ptc_color_a := TPTCColor(obj).a; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_a := 0; + End; + End; +End; + +Function ptc_color_direct(obj : TPTC_COLOR) : Boolean; + +Begin + Try + ptc_color_direct := TPTCColor(obj).direct; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_direct := False; + End; + End; +End; + +Function ptc_color_indexed(obj : TPTC_COLOR) : Boolean; + +Begin + Try + ptc_color_indexed := TPTCColor(obj).indexed; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_indexed := False; + End; + End; +End; + +Procedure ptc_color_assign(obj, color : TPTC_COLOR); + +Begin + Try + TPTCColor(obj).ASSign(TPTCColor(color)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_color_equals(obj, color : TPTC_COLOR) : Boolean; + +Begin + Try + ptc_color_equals := TPTCColor(obj).Equals(TPTCColor(color)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_color_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/colord.inc b/packages/ptc/src/c_api/colord.inc new file mode 100644 index 0000000000..8098bae6bc --- /dev/null +++ b/packages/ptc/src/c_api/colord.inc @@ -0,0 +1,18 @@ +{ setup } +Function ptc_color_create : TPTC_COLOR; +Function ptc_color_create_indexed(index : Integer) : TPTC_COLOR; +Function ptc_color_create_direct(r, g, b, a : Single) : TPTC_COLOR; +Procedure ptc_color_destroy(obj : TPTC_COLOR); + +{ data access } +Function ptc_color_index(obj : TPTC_COLOR) : Integer; +Function ptc_color_r(obj : TPTC_COLOR) : Single; +Function ptc_color_g(obj : TPTC_COLOR) : Single; +Function ptc_color_b(obj : TPTC_COLOR) : Single; +Function ptc_color_a(obj : TPTC_COLOR) : Single; +Function ptc_color_direct(obj : TPTC_COLOR) : Boolean; +Function ptc_color_indexed(obj : TPTC_COLOR) : Boolean; + +{ operators } +Procedure ptc_color_assign(obj, color : TPTC_COLOR); +Function ptc_color_equals(obj, color : TPTC_COLOR) : Boolean; diff --git a/packages/ptc/src/c_api/console.inc b/packages/ptc/src/c_api/console.inc new file mode 100644 index 0000000000..fd2779475f --- /dev/null +++ b/packages/ptc/src/c_api/console.inc @@ -0,0 +1,497 @@ +Function ptc_console_create : TPTC_CONSOLE; + +Begin + Try + ptc_console_create := TPTC_CONSOLE(TPTCConsole.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_create := Nil; + End; + End; +End; + +Procedure ptc_console_destroy(obj : TPTC_CONSOLE); + +Begin + If obj = Nil Then + Exit; + Try + TPTCBaseConsole(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_configure(obj : TPTC_CONSOLE; _file : String); + +Begin + Try + TPTCBaseConsole(obj).configure(_file); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_console_option(obj : TPTC_CONSOLE; _option : String) : Boolean; + +Begin + Try + ptc_console_option := TPTCBaseConsole(obj).option(_option); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_option := False; + End; + End; +End; + +Function ptc_console_mode(obj : TPTC_CONSOLE; index : Integer) : TPTC_MODE; + +Begin + Try + ptc_console_mode := TPTC_MODE(TPTCBaseConsole(obj).modes[index]); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_mode := Nil; + End; + End; +End; + +Procedure ptc_console_open(obj : TPTC_CONSOLE; title : String; pages : Integer); + +Begin + Try + TPTCBaseConsole(obj).open(title, pages); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_open_format(obj : TPTC_CONSOLE; title : String; format : TPTC_FORMAT; pages : Integer); + +Begin + Try + TPTCBaseConsole(obj).open(title, TPTCFormat(format), pages); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_open_resolution(obj : TPTC_CONSOLE; title : String; width, height : Integer; format : TPTC_FORMAT; pages : Integer); + +Begin + Try + TPTCBaseConsole(obj).open(title, width, height, TPTCFormat(format), pages); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_open_mode(obj : TPTC_CONSOLE; title : String; mode : TPTC_MODE; pages : Integer); + +Begin + Try + TPTCBaseConsole(obj).open(title, TPTCMode(mode), pages); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_close(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).close; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_flush(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).flush; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_finish(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).finish; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_update(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).update; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_update_area(obj : TPTC_CONSOLE; area : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).update(TPTCArea(area)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_console_key(obj : TPTC_CONSOLE) : Boolean; + +Begin + Try + ptc_console_key := TPTCBaseConsole(obj).key; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_key := False; + End; + End; +End; + +Procedure ptc_console_read(obj : TPTC_CONSOLE; key : TPTC_KEY); + +Var + tmp : TPTCKey; + +Begin + Try + tmp := TPTCBaseConsole(obj).read; + Try + TPTCKey(key).ASSign(tmp); + Finally + tmp.Destroy; + End; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_copy(obj : TPTC_CONSOLE; surface : TPTC_SURFACE); + +Begin + Try + TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_copy_area(obj : TPTC_CONSOLE; surface : TPTC_SURFACE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_console_lock(obj : TPTC_CONSOLE) : Pointer; + +Begin + Try + ptc_console_lock := TPTCBaseConsole(obj).lock; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_lock := Nil; + End; + End; +End; + +Procedure ptc_console_unlock(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).unlock; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_load(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_load_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_save(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_save_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_clear(obj : TPTC_CONSOLE); + +Begin + Try + TPTCBaseConsole(obj).clear; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_clear_color(obj : TPTC_CONSOLE; color : TPTC_COLOR); + +Begin + Try + TPTCBaseConsole(obj).clear(TPTCColor(color)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_clear_color_area(obj : TPTC_CONSOLE; color : TPTC_COLOR; area : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).clear(TPTCColor(color), TPTCArea(area)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_console_palette_set(obj : TPTC_CONSOLE; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseConsole(obj).palette(TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_console_palette_get(obj : TPTC_CONSOLE) : TPTC_PALETTE; + +Begin + Try + ptc_console_palette_get := TPTC_PALETTE(TPTCBaseConsole(obj).palette); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_palette_get := Nil; + End; + End; +End; + +Procedure ptc_console_clip_set(obj : TPTC_CONSOLE; area : TPTC_AREA); + +Begin + Try + TPTCBaseConsole(obj).clip(TPTCArea(area)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_console_width(obj : TPTC_CONSOLE) : Integer; + +Begin + Try + ptc_console_width := TPTCBaseConsole(obj).width; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_width := 0; + End; + End; +End; + +Function ptc_console_height(obj : TPTC_CONSOLE) : Integer; + +Begin + Try + ptc_console_height := TPTCBaseConsole(obj).height; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_height := 0; + End; + End; +End; + +Function ptc_console_pages(obj : TPTC_CONSOLE) : Integer; + +Begin + Try + ptc_console_pages := TPTCBaseConsole(obj).pages; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_pages := 0; + End; + End; +End; + +Function ptc_console_pitch(obj : TPTC_CONSOLE) : Integer; + +Begin + Try + ptc_console_pitch := TPTCBaseConsole(obj).pitch; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_pitch := 0; + End; + End; +End; + +Function ptc_console_area(obj : TPTC_CONSOLE) : TPTC_AREA; + +Begin + Try + ptc_console_area := TPTC_AREA(TPTCBaseConsole(obj).area); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_area := Nil; + End; + End; +End; + +Function ptc_console_clip(obj : TPTC_CONSOLE) : TPTC_AREA; + +Begin + Try + ptc_console_clip := TPTC_AREA(TPTCBaseConsole(obj).clip); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_clip := Nil; + End; + End; +End; + +Function ptc_console_format(obj : TPTC_CONSOLE) : TPTC_FORMAT; + +Begin + Try + ptc_console_format := TPTC_FORMAT(TPTCBaseConsole(obj).format); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_format := Nil; + End; + End; +End; + +Function ptc_console_name(obj : TPTC_CONSOLE) : String; + +Begin + Try + ptc_console_name := TPTCBaseConsole(obj).name; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_name := ''; + End; + End; +End; + +Function ptc_console_title(obj : TPTC_CONSOLE) : String; + +Begin + Try + ptc_console_title := TPTCBaseConsole(obj).title; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_title := ''; + End; + End; +End; + +Function ptc_console_information(obj : TPTC_CONSOLE) : String; + +Begin + Try + ptc_console_information := TPTCBaseConsole(obj).information; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_console_information := ''; + End; + End; +End; diff --git a/packages/ptc/src/c_api/consoled.inc b/packages/ptc/src/c_api/consoled.inc new file mode 100644 index 0000000000..3d00204192 --- /dev/null +++ b/packages/ptc/src/c_api/consoled.inc @@ -0,0 +1,83 @@ +{ setup } +Function ptc_console_create : TPTC_CONSOLE; +Procedure ptc_console_destroy(obj : TPTC_CONSOLE); + +{ console configuration } +Procedure ptc_console_configure(obj : TPTC_CONSOLE; _file : String); + +{ console option string } +Function ptc_console_option(obj : TPTC_CONSOLE; _option : String) : Boolean; + +{ console modes } +Function ptc_console_mode(obj : TPTC_CONSOLE; index : Integer) : TPTC_MODE; + +{ console management } +Procedure ptc_console_open(obj : TPTC_CONSOLE; title : String; pages : Integer); +Procedure ptc_console_open_format(obj : TPTC_CONSOLE; title : String; format : TPTC_FORMAT; pages : Integer); +Procedure ptc_console_open_resolution(obj : TPTC_CONSOLE; title : String; width, height : Integer; format : TPTC_FORMAT; pages : Integer); +Procedure ptc_console_open_mode(obj : TPTC_CONSOLE; title : String; mode : TPTC_MODE; pages : Integer); +Procedure ptc_console_close(obj : TPTC_CONSOLE); + +{ synchronization } +Procedure ptc_console_flush(obj : TPTC_CONSOLE); +Procedure ptc_console_finish(obj : TPTC_CONSOLE); +Procedure ptc_console_update(obj : TPTC_CONSOLE); +Procedure ptc_console_update_area(obj : TPTC_CONSOLE; area : TPTC_AREA); + +{ keyboard input } +Function ptc_console_key(obj : TPTC_CONSOLE) : Boolean; +Procedure ptc_console_read(obj : TPTC_CONSOLE; key : TPTC_KEY); + +{ copy to surface } +Procedure ptc_console_copy(obj : TPTC_CONSOLE; surface : TPTC_SURFACE); +Procedure ptc_console_copy_area(obj : TPTC_CONSOLE; surface : TPTC_SURFACE; source, destination : TPTC_AREA); + +{ memory access } +Function ptc_console_lock(obj : TPTC_CONSOLE) : Pointer; +Procedure ptc_console_unlock(obj : TPTC_CONSOLE); + +{ load pixels to console } +Procedure ptc_console_load(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); +Procedure ptc_console_load_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +{ save console pixels } +Procedure ptc_console_save(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); +Procedure ptc_console_save_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +{ clear console } +Procedure ptc_console_clear(obj : TPTC_CONSOLE); +Procedure ptc_console_clear_color(obj : TPTC_CONSOLE; color : TPTC_COLOR); +Procedure ptc_console_clear_color_area(obj : TPTC_CONSOLE; color : TPTC_COLOR; area : TPTC_AREA); + +{ console palette } +Procedure ptc_console_palette_set(obj : TPTC_CONSOLE; palette : TPTC_PALETTE); +Function ptc_console_palette_get(obj : TPTC_CONSOLE) : TPTC_PALETTE; + +{ console clip area } +Procedure ptc_console_clip_set(obj : TPTC_CONSOLE; area : TPTC_AREA); + +{ data access } +Function ptc_console_width(obj : TPTC_CONSOLE) : Integer; +Function ptc_console_height(obj : TPTC_CONSOLE) : Integer; +Function ptc_console_pages(obj : TPTC_CONSOLE) : Integer; +Function ptc_console_pitch(obj : TPTC_CONSOLE) : Integer; +Function ptc_console_area(obj : TPTC_CONSOLE) : TPTC_AREA; +Function ptc_console_clip(obj : TPTC_CONSOLE) : TPTC_AREA; +Function ptc_console_format(obj : TPTC_CONSOLE) : TPTC_FORMAT; +Function ptc_console_name(obj : TPTC_CONSOLE) : String; +Function ptc_console_title(obj : TPTC_CONSOLE) : String; +Function ptc_console_information(obj : TPTC_CONSOLE) : String; + +{ extension functions } +{#ifdef __PTC_WIN32_EXTENSIONS__ +CAPI void PTCAPI ptc_console_open_window(PTC_CONSOLE object,HWND window,int pages); +CAPI void PTCAPI ptc_console_open_window_format(PTC_CONSOLE object,HWND window,PTC_FORMAT format,int pages); +CAPI void PTCAPI ptc_console_open_window_resolution(PTC_CONSOLE object,HWND window,int width,int height,PTC_FORMAT format,int pages); +CAPI void PTCAPI ptc_console_open_window_mode(PTC_CONSOLE object,HWND window,PTC_MODE mode,int pages); +CAPI HWND PTCAPI ptc_console_window(PTC_CONSOLE object); +CAPI LPDIRECTDRAW PTCAPI ptc_console_lpDD(PTC_CONSOLE object); +CAPI LPDIRECTDRAW2 PTCAPI ptc_console_lpDD2(PTC_CONSOLE object); +CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS(PTC_CONSOLE object); +CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_primary(PTC_CONSOLE object); +CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_secondary(PTC_CONSOLE object); +#endif} diff --git a/packages/ptc/src/c_api/copy.inc b/packages/ptc/src/c_api/copy.inc new file mode 100644 index 0000000000..838c812b78 --- /dev/null +++ b/packages/ptc/src/c_api/copy.inc @@ -0,0 +1,74 @@ +Function ptc_copy_create : TPTC_COPY; + +Begin + Try + ptc_copy_create := TPTC_COPY(TPTCCopy.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_copy_create := Nil; + End; + End; +End; + +Procedure ptc_copy_destroy(obj : TPTC_COPY); + +Begin + If obj = Nil Then + Exit; + Try + TPTCCopy(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_copy_request(obj : TPTC_COPY; source, destination : TPTC_FORMAT); + +Begin + Try + TPTCCopy(obj).request(TPTCFormat(source), TPTCFormat(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_copy_palette(obj : TPTC_COPY; source, destination : TPTC_PALETTE); + +Begin + Try + TPTCCopy(obj).palette(TPTCPalette(source), TPTCPalette(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_copy_copy(obj : TPTC_COPY; source_pixels : Pointer; source_x, source_y, source_width, source_height, source_pitch : Integer; + destination_pixels : Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch : Integer); + +Begin + Try + TPTCCopy(obj).copy(source_pixels, source_x, source_y, source_width, source_height, source_pitch, destination_pixels, destination_x, destination_y, destination_width, destination_height, destination_pitch); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_copy_option(obj : TPTC_COPY; option : String) : Boolean; + +Begin + Try + TPTCCopy(obj).option(option); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_copy_option := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/copyd.inc b/packages/ptc/src/c_api/copyd.inc new file mode 100644 index 0000000000..d87cc3552f --- /dev/null +++ b/packages/ptc/src/c_api/copyd.inc @@ -0,0 +1,16 @@ +{ setup } +Function ptc_copy_create : TPTC_COPY; +Procedure ptc_copy_destroy(obj : TPTC_COPY); + +{ set source and destination formats } +Procedure ptc_copy_request(obj : TPTC_COPY; source, destination : TPTC_FORMAT); + +{ set source and destination palettes } +Procedure ptc_copy_palette(obj : TPTC_COPY; source, destination : TPTC_PALETTE); + +{ copy pixels } +Procedure ptc_copy_copy(obj : TPTC_COPY; source_pixels : Pointer; source_x, source_y, source_width, source_height, source_pitch : Integer; + destination_pixels : Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch : Integer); + +{ copy option string } +Function ptc_copy_option(obj : TPTC_COPY; option : String) : Boolean; diff --git a/packages/ptc/src/c_api/error.inc b/packages/ptc/src/c_api/error.inc new file mode 100644 index 0000000000..af05fbb66b --- /dev/null +++ b/packages/ptc/src/c_api/error.inc @@ -0,0 +1,96 @@ +Function ptc_error_create(message : String) : TPTC_ERROR; + +Begin + Try + ptc_error_create := TPTC_ERROR(TPTCError.Create(message)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_error_create := Nil; + End; + End; +End; + +Function ptc_error_create_composite(message : String; error : TPTC_ERROR) : TPTC_ERROR; + +Begin + Try + ptc_error_create_composite := TPTC_ERROR(TPTCError.Create(message, TPTCError(error))); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_error_create_composite := Nil; + End; + End; +End; + +Procedure ptc_error_destroy(obj : TPTC_ERROR); + +Begin + If obj = Nil Then + Exit; + Try + TPTCError(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_error_report(obj : TPTC_ERROR); + +Begin + Try + TPTCError(obj).report; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_error_message(obj : TPTC_ERROR) : String; + +Begin + Try + ptc_error_message := TPTCError(obj).message; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_error_message := ''; + End; + End; +End; + +Procedure ptc_error_assign(obj, error : TPTC_ERROR); + +Begin + Try + TPTCError(obj).ASSign(TPTCError(error)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_error_equals(obj, error : TPTC_ERROR) : Boolean; + +Begin + Try + ptc_error_equals := TPTCError(obj).Equals(TPTCError(error)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_error_equals := False; + End; + End; +End; + +Procedure ptc_error_handler(handler : TPTC_ERROR_HANDLER); + +Begin + ptc_exception_handler(handler); +End; diff --git a/packages/ptc/src/c_api/errord.inc b/packages/ptc/src/c_api/errord.inc new file mode 100644 index 0000000000..0eff904d73 --- /dev/null +++ b/packages/ptc/src/c_api/errord.inc @@ -0,0 +1,15 @@ +Type + TPTC_ERROR_HANDLER = Procedure(error : TPTC_ERROR); + +Function ptc_error_create(message : String) : TPTC_ERROR; +Function ptc_error_create_composite(message : String; error : TPTC_ERROR) : TPTC_ERROR; +Procedure ptc_error_destroy(obj : TPTC_ERROR); + +Procedure ptc_error_report(obj : TPTC_ERROR); + +Function ptc_error_message(obj : TPTC_ERROR) : String; + +Procedure ptc_error_assign(obj, error : TPTC_ERROR); +Function ptc_error_equals(obj, error : TPTC_ERROR) : Boolean; + +Procedure ptc_error_handler(handler : TPTC_ERROR_HANDLER); diff --git a/packages/ptc/src/c_api/except.inc b/packages/ptc/src/c_api/except.inc new file mode 100644 index 0000000000..d6eb32b576 --- /dev/null +++ b/packages/ptc/src/c_api/except.inc @@ -0,0 +1,23 @@ +Var + ptc_error_handler_function : TPTC_ERROR_HANDLER; + +Procedure ptc_error_handler_default(error : TPTC_ERROR); + +Begin + TPTCError(error).report; +End; + +Procedure ptc_exception_handler(handler : TPTC_ERROR_HANDLER); + +Begin + If handler = Nil Then + ptc_error_handler_function := @ptc_error_handler_default + Else + ptc_error_handler_function := handler; +End; + +Procedure ptc_exception_handle(error : TPTCError); + +Begin + ptc_error_handler_function(TPTC_ERROR(error)); +End; diff --git a/packages/ptc/src/c_api/exceptd.inc b/packages/ptc/src/c_api/exceptd.inc new file mode 100644 index 0000000000..b84497aa61 --- /dev/null +++ b/packages/ptc/src/c_api/exceptd.inc @@ -0,0 +1,2 @@ +Procedure ptc_exception_handler(handler : TPTC_ERROR_HANDLER); +Procedure ptc_exception_handle(error : TPTCError); diff --git a/packages/ptc/src/c_api/format.inc b/packages/ptc/src/c_api/format.inc new file mode 100644 index 0000000000..55db5e762f --- /dev/null +++ b/packages/ptc/src/c_api/format.inc @@ -0,0 +1,191 @@ +Function ptc_format_create : TPTC_FORMAT; + +Begin + Try + ptc_format_create := TPTC_FORMAT(TPTCFormat.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_create := Nil; + End; + End; +End; + +Function ptc_format_create_indexed(bits : Integer) : TPTC_FORMAT; + +Begin + Try + ptc_format_create_indexed := TPTC_FORMAT(TPTCFormat.Create(bits)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_create_indexed := Nil; + End; + End; +End; + +Function ptc_format_create_direct(bits : Integer; r, g, b, a : int32) : TPTC_FORMAT; + +Begin + Try + ptc_format_create_direct := TPTC_FORMAT(TPTCFormat.Create(bits, r, g, b, a)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_create_direct := Nil; + End; + End; +End; + +Procedure ptc_format_destroy(obj : TPTC_FORMAT); + +Begin + If obj = Nil Then + Exit; + Try + TPTCFormat(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_format_r(obj : TPTC_FORMAT) : int32; + +Begin + Try + ptc_format_r := TPTCFormat(obj).r; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_r := 0; + End; + End; +End; + +Function ptc_format_g(obj : TPTC_FORMAT) : int32; + +Begin + Try + ptc_format_g := TPTCFormat(obj).g; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_g := 0; + End; + End; +End; + +Function ptc_format_b(obj : TPTC_FORMAT) : int32; + +Begin + Try + ptc_format_b := TPTCFormat(obj).b; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_b := 0; + End; + End; +End; + +Function ptc_format_a(obj : TPTC_FORMAT) : int32; + +Begin + Try + ptc_format_a := TPTCFormat(obj).a; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_a := 0; + End; + End; +End; + +Function ptc_format_bits(obj : TPTC_FORMAT) : Integer; + +Begin + Try + ptc_format_bits := TPTCFormat(obj).bits; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_bits := 0; + End; + End; +End; + +Function ptc_format_bytes(obj : TPTC_FORMAT) : Integer; + +Begin + Try + ptc_format_bytes := TPTCFormat(obj).bytes; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_bytes := 0; + End; + End; +End; + +Function ptc_format_direct(obj : TPTC_FORMAT) : Boolean; + +Begin + Try + ptc_format_direct := TPTCFormat(obj).direct; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_direct := False; + End; + End; +End; + +Function ptc_format_indexed(obj : TPTC_FORMAT) : Boolean; + +Begin + Try + ptc_format_indexed := TPTCFormat(obj).indexed; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_indexed := False; + End; + End; +End; + +Procedure ptc_format_assign(obj, format : TPTC_FORMAT); + +Begin + Try + TPTCFormat(obj).ASSign(TPTCFormat(format)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_format_equals(obj, format : TPTC_FORMAT) : Boolean; + +Begin + Try + ptc_format_equals := TPTCFormat(obj).Equals(TPTCFormat(format)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_format_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/formatd.inc b/packages/ptc/src/c_api/formatd.inc new file mode 100644 index 0000000000..b235e13078 --- /dev/null +++ b/packages/ptc/src/c_api/formatd.inc @@ -0,0 +1,19 @@ +{ setup } +Function ptc_format_create : TPTC_FORMAT; +Function ptc_format_create_indexed(bits : Integer) : TPTC_FORMAT; +Function ptc_format_create_direct(bits : Integer; r, g, b, a : int32) : TPTC_FORMAT; +Procedure ptc_format_destroy(obj : TPTC_FORMAT); + +{ data access } +Function ptc_format_r(obj : TPTC_FORMAT) : int32; +Function ptc_format_g(obj : TPTC_FORMAT) : int32; +Function ptc_format_b(obj : TPTC_FORMAT) : int32; +Function ptc_format_a(obj : TPTC_FORMAT) : int32; +Function ptc_format_bits(obj : TPTC_FORMAT) : Integer; +Function ptc_format_bytes(obj : TPTC_FORMAT) : Integer; +Function ptc_format_direct(obj : TPTC_FORMAT) : Boolean; +Function ptc_format_indexed(obj : TPTC_FORMAT) : Boolean; + +{ operators } +Procedure ptc_format_assign(obj, format : TPTC_FORMAT); +Function ptc_format_equals(obj, format : TPTC_FORMAT) : Boolean; diff --git a/packages/ptc/src/c_api/index.inc b/packages/ptc/src/c_api/index.inc new file mode 100644 index 0000000000..4698836290 --- /dev/null +++ b/packages/ptc/src/c_api/index.inc @@ -0,0 +1,14 @@ +Type + { object handles } + TPTC_KEY = Pointer; { equivalent to Object Pascal TPTCKey } + TPTC_AREA = Pointer; { equivalent to Object Pascal TPTCArea } + TPTC_MODE = Pointer; { equivalent to Object Pascal TPTCMode } + TPTC_COPY = Pointer; { equivalent to Object Pascal TPTCCopy } + TPTC_CLEAR = Pointer; { equivalent to Object Pascal TPTCClear } + TPTC_TIMER = Pointer; { equivalent to Object Pascal TPTCTimer } + TPTC_ERROR = Pointer; { equivalent to Object Pascal TPTCError } + TPTC_COLOR = Pointer; { equivalent to Object Pascal TPTCColor } + TPTC_FORMAT = Pointer; { equivalent to Object Pascal TPTCFormat } + TPTC_PALETTE = Pointer; { equivalent to Object Pascal TPTCPalette } + TPTC_SURFACE = Pointer; { equivalent to Object Pascal TPTCBaseSurface } + TPTC_CONSOLE = Pointer; { equivalent to Object Pascal TPTCBaseConsole } diff --git a/packages/ptc/src/c_api/key.inc b/packages/ptc/src/c_api/key.inc new file mode 100644 index 0000000000..d622dba32e --- /dev/null +++ b/packages/ptc/src/c_api/key.inc @@ -0,0 +1,107 @@ +Function ptc_key_create(code : Integer; alt, shift, control : Boolean) : TPTC_KEY; + +Begin + Try + ptc_key_create := TPTC_KEY(TPTCKey.Create(code, alt, shift, control)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_create := Nil; + End; + End; +End; + +Procedure ptc_key_destroy(obj : TPTC_KEY); + +Begin + If obj = Nil Then + Exit; + Try + TPTCKey(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_key_code(obj : TPTC_KEY) : Integer; + +Begin + Try + ptc_key_code := Integer(TPTCKey(obj).code); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_code := 0; + End; + End; +End; + +Function ptc_key_alt(obj : TPTC_KEY) : Boolean; + +Begin + Try + ptc_key_alt := TPTCKey(obj).alt; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_alt := False; + End; + End; +End; + +Function ptc_key_shift(obj : TPTC_KEY) : Boolean; + +Begin + Try + ptc_key_shift := TPTCKey(obj).shift; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_shift := False; + End; + End; +End; + +Function ptc_key_control(obj : TPTC_KEY) : Boolean; + +Begin + Try + ptc_key_control := TPTCKey(obj).control; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_control := False; + End; + End; +End; + +Procedure ptc_key_assign(obj : TPTC_KEY; key : TPTC_KEY); + +Begin + Try + TPTCKey(obj).ASSign(TPTCKey(key)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_key_equals(obj : TPTC_KEY; key : TPTC_KEY) : Boolean; + +Begin + Try + ptc_key_equals := TPTCKey(obj).Equals(TPTCKey(key)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_key_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/keyd.inc b/packages/ptc/src/c_api/keyd.inc new file mode 100644 index 0000000000..a8b3f7b26f --- /dev/null +++ b/packages/ptc/src/c_api/keyd.inc @@ -0,0 +1,126 @@ +{ setup } +Function ptc_key_create(code : Integer; alt, shift, control : Boolean) : TPTC_KEY; +Procedure ptc_key_destroy(obj : TPTC_KEY); + +{ key code } +Function ptc_key_code(obj : TPTC_KEY) : Integer; + +{ modifiers } +Function ptc_key_alt(obj : TPTC_KEY) : Boolean; +Function ptc_key_shift(obj : TPTC_KEY) : Boolean; +Function ptc_key_control(obj : TPTC_KEY) : Boolean; + +{ operators } +Procedure ptc_key_assign(obj : TPTC_KEY; key : TPTC_KEY); +Function ptc_key_equals(obj : TPTC_KEY; key : TPTC_KEY) : Boolean; + +{ key codes } +{#define PTC_KEY_ENTER '\n' +#define PTC_KEY_BACKSPACE '\b' +#define PTC_KEY_TAB '\t' +#define PTC_KEY_CANCEL 0x03 +#define PTC_KEY_CLEAR 0x0C +#define PTC_KEY_SHIFT 0x10 +#define PTC_KEY_CONTROL 0x11 +#define PTC_KEY_ALT 0x12 +#define PTC_KEY_PAUSE 0x13 +#define PTC_KEY_CAPSLOCK 0x14 +#define PTC_KEY_ESCAPE 0x1B +#define PTC_KEY_SPACE 0x20 +#define PTC_KEY_PAGEUP 0x21 +#define PTC_KEY_PAGEDOWN 0x22 +#define PTC_KEY_END 0x23 +#define PTC_KEY_HOME 0x24 +#define PTC_KEY_LEFT 0x25 +#define PTC_KEY_UP 0x26 +#define PTC_KEY_RIGHT 0x27 +#define PTC_KEY_DOWN 0x28 +#define PTC_KEY_COMMA 0x2C +#define PTC_KEY_PERIOD 0x2E +#define PTC_KEY_SLASH 0x2F +#define PTC_KEY_ZERO 0x30 +#define PTC_KEY_ONE 0x31 +#define PTC_KEY_TWO 0x32 +#define PTC_KEY_THREE 0x33 +#define PTC_KEY_FOUR 0x34 +#define PTC_KEY_FIVE 0x35 +#define PTC_KEY_SIX 0x36 +#define PTC_KEY_SEVEN 0x37 +#define PTC_KEY_EIGHT 0x38 +#define PTC_KEY_NINE 0x39 +#define PTC_KEY_SEMICOLON 0x3B +#define PTC_KEY_EQUALS 0x3D +#define PTC_KEY_A 0x41 +#define PTC_KEY_B 0x42 +#define PTC_KEY_C 0x43 +#define PTC_KEY_D 0x44 +#define PTC_KEY_E 0x45 +#define PTC_KEY_F 0x46 +#define PTC_KEY_G 0x47 +#define PTC_KEY_H 0x48 +#define PTC_KEY_I 0x49 +#define PTC_KEY_J 0x4A +#define PTC_KEY_K 0x4B +#define PTC_KEY_L 0x4C +#define PTC_KEY_M 0x4D +#define PTC_KEY_N 0x4E +#define PTC_KEY_O 0x4F +#define PTC_KEY_P 0x50 +#define PTC_KEY_Q 0x51 +#define PTC_KEY_R 0x52 +#define PTC_KEY_S 0x53 +#define PTC_KEY_T 0x54 +#define PTC_KEY_U 0x55 +#define PTC_KEY_V 0x56 +#define PTC_KEY_W 0x57 +#define PTC_KEY_X 0x58 +#define PTC_KEY_Y 0x59 +#define PTC_KEY_Z 0x5A +#define PTC_KEY_OPENBRACKET 0x5B +#define PTC_KEY_BACKSLASH 0x5C +#define PTC_KEY_CLOSEBRACKET 0x5D +#define PTC_KEY_NUMPAD0 0x60 +#define PTC_KEY_NUMPAD1 0x61 +#define PTC_KEY_NUMPAD2 0x62 +#define PTC_KEY_NUMPAD3 0x63 +#define PTC_KEY_NUMPAD4 0x64 +#define PTC_KEY_NUMPAD5 0x65 +#define PTC_KEY_NUMPAD6 0x66 +#define PTC_KEY_NUMPAD7 0x67 +#define PTC_KEY_NUMPAD8 0x68 +#define PTC_KEY_NUMPAD9 0x69 +#define PTC_KEY_MULTIPLY 0x6A +#define PTC_KEY_ADD 0x6B +#define PTC_KEY_SEPARATOR 0x6C +#define PTC_KEY_SUBTRACT 0x6D +#define PTC_KEY_DECIMAL 0x6E +#define PTC_KEY_DIVIDE 0x6F +#define PTC_KEY_F1 0x70 +#define PTC_KEY_F2 0x71 +#define PTC_KEY_F3 0x72 +#define PTC_KEY_F4 0x73 +#define PTC_KEY_F5 0x74 +#define PTC_KEY_F6 0x75 +#define PTC_KEY_F7 0x76 +#define PTC_KEY_F8 0x77 +#define PTC_KEY_F9 0x78 +#define PTC_KEY_F10 0x79 +#define PTC_KEY_F11 0x7A +#define PTC_KEY_F12 0x7B +#define PTC_KEY_DELETE 0x7F +#define PTC_KEY_NUMLOCK 0x90 +#define PTC_KEY_SCROLLLOCK 0x91 +#define PTC_KEY_PRINTSCREEN 0x9A +#define PTC_KEY_INSERT 0x9B +#define PTC_KEY_HELP 0x9C +#define PTC_KEY_META 0x9D +#define PTC_KEY_BACKQUOTE 0xC0 +#define PTC_KEY_QUOTE 0xDE +#define PTC_KEY_FINAL 0x18 +#define PTC_KEY_CONVERT 0x1C +#define PTC_KEY_NONCONVERT 0x1D +#define PTC_KEY_ACCEPT 0x1E +#define PTC_KEY_MODECHANGE 0x1F +#define PTC_KEY_KANA 0x15 +#define PTC_KEY_KANJI 0x19 +#define PTC_KEY_UNDEFINED 0x0} diff --git a/packages/ptc/src/c_api/mode.inc b/packages/ptc/src/c_api/mode.inc new file mode 100644 index 0000000000..7bc7369b16 --- /dev/null +++ b/packages/ptc/src/c_api/mode.inc @@ -0,0 +1,121 @@ +Function ptc_mode_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_MODE; + +Begin + Try + ptc_mode_create := TPTC_MODE(TPTCMode.Create(width, height, TPTCFormat(format))); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_create := Nil; + End; + End; +End; + +Function ptc_mode_create_invalid : TPTC_MODE; + +Begin + Try + ptc_mode_create_invalid := TPTC_MODE(TPTCMode.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_create_invalid := Nil; + End; + End; +End; + +Procedure ptc_mode_destroy(obj : TPTC_MODE); + +Begin + If obj = Nil Then + Exit; + Try + TPTCMode(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_mode_valid(obj : TPTC_MODE) : Boolean; + +Begin + Try + ptc_mode_valid := TPTCMode(obj).valid; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_valid := False; + End; + End; +End; + +Function ptc_mode_width(obj : TPTC_MODE) : Integer; + +Begin + Try + ptc_mode_width := TPTCMode(obj).width; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_width := 0; + End; + End; +End; + +Function ptc_mode_height(obj : TPTC_MODE) : Integer; + +Begin + Try + ptc_mode_height := TPTCMode(obj).height; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_height := 0; + End; + End; +End; + +Function ptc_mode_format(obj : TPTC_MODE) : TPTC_FORMAT; + +Begin + Try + ptc_mode_format := TPTC_FORMAT(TPTCMode(obj).format); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_format := Nil; + End; + End; +End; + +Procedure ptc_mode_assign(obj, mode : TPTC_MODE); + +Begin + Try + TPTCMode(obj).ASSign(TPTCMode(mode)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_mode_equals(obj, mode : TPTC_MODE) : Boolean; + +Begin + Try + ptc_mode_equals := TPTCMode(obj).Equals(TPTCMode(mode)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_mode_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/moded.inc b/packages/ptc/src/c_api/moded.inc new file mode 100644 index 0000000000..61c9d6f8b6 --- /dev/null +++ b/packages/ptc/src/c_api/moded.inc @@ -0,0 +1,16 @@ +{ setup } +Function ptc_mode_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_MODE; +Function ptc_mode_create_invalid : TPTC_MODE; +Procedure ptc_mode_destroy(obj : TPTC_MODE); + +{ valid mode flag } +Function ptc_mode_valid(obj : TPTC_MODE) : Boolean; + +{ data access } +Function ptc_mode_width(obj : TPTC_MODE) : Integer; +Function ptc_mode_height(obj : TPTC_MODE) : Integer; +Function ptc_mode_format(obj : TPTC_MODE) : TPTC_FORMAT; + +{ operators } +Procedure ptc_mode_assign(obj, mode : TPTC_MODE); +Function ptc_mode_equals(obj, mode : TPTC_MODE) : Boolean; diff --git a/packages/ptc/src/c_api/palette.inc b/packages/ptc/src/c_api/palette.inc new file mode 100644 index 0000000000..6cf5e6c054 --- /dev/null +++ b/packages/ptc/src/c_api/palette.inc @@ -0,0 +1,126 @@ +Function ptc_palette_create : TPTC_PALETTE; + +Begin + Try + ptc_palette_create := TPTC_PALETTE(TPTCPalette.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_palette_create := Nil; + End; + End; +End; + +{Function ptc_palette_create_data(data : Pint32) : TPTC_PALETTE; + +Begin + Try + ptc_palette_create_data := TPTC_PALETTE(TPTCPalette.Create(data)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_palette_create_data := Nil; + End; + End; +End;} + +Procedure ptc_palette_destroy(obj : TPTC_PALETTE); + +Begin + If obj = Nil Then + Exit; + Try + TPTCPalette(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_palette_lock(obj : TPTC_PALETTE) : Pint32; + +Begin + Try + ptc_palette_lock := TPTCPalette(obj).lock; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_palette_lock := Nil; + End; + End; +End; + +Procedure ptc_palette_unlock(obj : TPTC_PALETTE); + +Begin + Try + TPTCPalette(obj).unlock; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_palette_load(obj : TPTC_PALETTE; data : Pint32); + +Begin + Try + TPTCPalette(obj).load(data); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_palette_save(obj : TPTC_PALETTE; data : Pint32); + +Begin + Try + TPTCPalette(obj).save(data); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_palette_data(obj : TPTC_PALETTE) : Pint32; + +Begin + Try + ptc_palette_data := TPTCPalette(obj).data; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_palette_data := Nil; + End; + End; +End; + +Procedure ptc_palette_assign(obj, palette : TPTC_PALETTE); + +Begin + Try + TPTCPalette(obj).ASSign(TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_palette_equals(obj, palette : TPTC_PALETTE) : Boolean; + +Begin + Try + ptc_palette_equals := TPTCPalette(obj).Equals(TPTCPalette(palette)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_palette_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/paletted.inc b/packages/ptc/src/c_api/paletted.inc new file mode 100644 index 0000000000..ffa28ac3d0 --- /dev/null +++ b/packages/ptc/src/c_api/paletted.inc @@ -0,0 +1,21 @@ +{ setup } +Function ptc_palette_create : TPTC_PALETTE; +{Function ptc_palette_create_data(data : Pint32) : TPTC_PALETTE;} +Procedure ptc_palette_destroy(obj : TPTC_PALETTE); + +{ memory access } +Function ptc_palette_lock(obj : TPTC_PALETTE) : Pint32; +Procedure ptc_palette_unlock(obj : TPTC_PALETTE); + +{ load palette data } +Procedure ptc_palette_load(obj : TPTC_PALETTE; data : Pint32); + +{ save palette data } +Procedure ptc_palette_save(obj : TPTC_PALETTE; data : Pint32); + +{ get palette data } +Function ptc_palette_data(obj : TPTC_PALETTE) : Pint32; + +{ operators } +Procedure ptc_palette_assign(obj, palette : TPTC_PALETTE); +Function ptc_palette_equals(obj, palette : TPTC_PALETTE) : Boolean; diff --git a/packages/ptc/src/c_api/surface.inc b/packages/ptc/src/c_api/surface.inc new file mode 100644 index 0000000000..13e95d9043 --- /dev/null +++ b/packages/ptc/src/c_api/surface.inc @@ -0,0 +1,284 @@ +Function ptc_surface_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_SURFACE; + +Begin + Try + ptc_surface_create := TPTC_SURFACE(TPTCSurface.Create(width, height, TPTCFormat(format))); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_create := Nil; + End; + End; +End; + +Procedure ptc_surface_destroy(obj : TPTC_SURFACE); + +Begin + If obj = Nil Then + Exit; + Try + TPTCBaseSurface(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_copy(obj : TPTC_SURFACE; surface : TPTC_SURFACE); + +Begin + Try + TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_copy_area(obj : TPTC_SURFACE; surface : TPTC_SURFACE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_surface_lock(obj : TPTC_SURFACE) : Pointer; + +Begin + Try + ptc_surface_lock := TPTCBaseSurface(obj).lock; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_lock := Nil; + End; + End; +End; + +Procedure ptc_surface_unlock(obj : TPTC_SURFACE); + +Begin + Try + TPTCBaseSurface(obj).unlock; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_load(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_load_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_save(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_save_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +Begin + Try + TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_clear(obj : TPTC_SURFACE); + +Begin + Try + TPTCBaseSurface(obj).clear; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_clear_color(obj : TPTC_SURFACE; color : TPTC_COLOR); + +Begin + Try + TPTCBaseSurface(obj).clear(TPTCColor(color)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_clear_color_area(obj : TPTC_SURFACE; color : TPTC_COLOR; area : TPTC_AREA); + +Begin + Try + TPTCBaseSurface(obj).clear(TPTCColor(color), TPTCArea(area)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_surface_palette_set(obj : TPTC_SURFACE; palette : TPTC_PALETTE); + +Begin + Try + TPTCBaseSurface(obj).palette(TPTCPalette(palette)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_surface_palette_get(obj : TPTC_SURFACE) : TPTC_PALETTE; + +Begin + Try + ptc_surface_palette_get := TPTC_PALETTE(TPTCBaseSurface(obj).palette); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_palette_get := Nil; + End; + End; +End; + +Procedure ptc_surface_clip_set(obj : TPTC_SURFACE; area : TPTC_AREA); + +Begin + Try + TPTCBaseSurface(obj).clip(TPTCArea(area)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_surface_width(obj : TPTC_SURFACE) : Integer; + +Begin + Try + ptc_surface_width := TPTCBaseSurface(obj).width; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_width := 0; + End; + End; +End; + +Function ptc_surface_height(obj : TPTC_SURFACE) : Integer; + +Begin + Try + ptc_surface_height := TPTCBaseSurface(obj).height; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_height := 0; + End; + End; +End; + +Function ptc_surface_pitch(obj : TPTC_SURFACE) : Integer; + +Begin + Try + ptc_surface_pitch := TPTCBaseSurface(obj).pitch; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_pitch := 0; + End; + End; +End; + +Function ptc_surface_area(obj : TPTC_SURFACE) : TPTC_AREA; + +Begin + Try + ptc_surface_area := TPTC_AREA(TPTCBaseSurface(obj).area); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_area := Nil; + End; + End; +End; + +Function ptc_surface_clip(obj : TPTC_SURFACE) : TPTC_AREA; + +Begin + Try + ptc_surface_clip := TPTC_AREA(TPTCBaseSurface(obj).clip); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_clip := Nil; + End; + End; +End; + +Function ptc_surface_format(obj : TPTC_SURFACE) : TPTC_FORMAT; + +Begin + Try + ptc_surface_format := TPTC_FORMAT(TPTCBaseSurface(obj).format); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_format := Nil; + End; + End; +End; + +Function ptc_surface_option(obj : TPTC_SURFACE; _option : String) : Boolean; + +Begin + Try + ptc_surface_option := TPTCBaseSurface(obj).option(_option); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_surface_option := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/surfaced.inc b/packages/ptc/src/c_api/surfaced.inc new file mode 100644 index 0000000000..986de99d8e --- /dev/null +++ b/packages/ptc/src/c_api/surfaced.inc @@ -0,0 +1,42 @@ +{ setup } +Function ptc_surface_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_SURFACE; +Procedure ptc_surface_destroy(obj : TPTC_SURFACE); + +{ copy to surface } +Procedure ptc_surface_copy(obj : TPTC_SURFACE; surface : TPTC_SURFACE); +Procedure ptc_surface_copy_area(obj : TPTC_SURFACE; surface : TPTC_SURFACE; source, destination : TPTC_AREA); + +{ memory access } +Function ptc_surface_lock(obj : TPTC_SURFACE) : Pointer; +Procedure ptc_surface_unlock(obj : TPTC_SURFACE); + +{ load pixels to surface } +Procedure ptc_surface_load(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); +Procedure ptc_surface_load_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +{ save surface pixels } +Procedure ptc_surface_save(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE); +Procedure ptc_surface_save_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA); + +{ clear surface } +Procedure ptc_surface_clear(obj : TPTC_SURFACE); +Procedure ptc_surface_clear_color(obj : TPTC_SURFACE; color : TPTC_COLOR); +Procedure ptc_surface_clear_color_area(obj : TPTC_SURFACE; color : TPTC_COLOR; area : TPTC_AREA); + +{ surface palette } +Procedure ptc_surface_palette_set(obj : TPTC_SURFACE; palette : TPTC_PALETTE); +Function ptc_surface_palette_get(obj : TPTC_SURFACE) : TPTC_PALETTE; + +{ surface clip area } +Procedure ptc_surface_clip_set(obj : TPTC_SURFACE; area : TPTC_AREA); + +{ data access } +Function ptc_surface_width(obj : TPTC_SURFACE) : Integer; +Function ptc_surface_height(obj : TPTC_SURFACE) : Integer; +Function ptc_surface_pitch(obj : TPTC_SURFACE) : Integer; +Function ptc_surface_area(obj : TPTC_SURFACE) : TPTC_AREA; +Function ptc_surface_clip(obj : TPTC_SURFACE) : TPTC_AREA; +Function ptc_surface_format(obj : TPTC_SURFACE) : TPTC_FORMAT; + +{ surface option string } +Function ptc_surface_option(obj : TPTC_SURFACE; _option : String) : Boolean; diff --git a/packages/ptc/src/c_api/timer.inc b/packages/ptc/src/c_api/timer.inc new file mode 100644 index 0000000000..32f2f6ae66 --- /dev/null +++ b/packages/ptc/src/c_api/timer.inc @@ -0,0 +1,126 @@ +Function ptc_timer_create : TPTC_TIMER; + +Begin + Try + ptc_timer_create := TPTC_TIMER(TPTCTimer.Create); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_timer_create := Nil; + End; + End; +End; + +Procedure ptc_timer_destroy(obj : TPTC_TIMER); + +Begin + If obj = Nil Then + Exit; + Try + TPTCTimer(obj).Destroy; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_timer_set(obj : TPTC_TIMER; time : Double); + +Begin + Try + TPTCTimer(obj).settime(time); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_timer_start(obj : TPTC_TIMER); + +Begin + Try + TPTCTimer(obj).start; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Procedure ptc_timer_stop(obj : TPTC_TIMER); + +Begin + Try + TPTCTimer(obj).stop; + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_timer_time(obj : TPTC_TIMER) : Double; + +Begin + Try + ptc_timer_time := TPTCTimer(obj).time; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_timer_time := 0; + End; + End; +End; + +Function ptc_timer_delta(obj : TPTC_TIMER) : Double; + +Begin + Try + ptc_timer_delta := TPTCTimer(obj).delta; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_timer_delta := 0; + End; + End; +End; + +Function ptc_timer_resolution(obj : TPTC_TIMER) : Double; + +Begin + Try + ptc_timer_resolution := TPTCTimer(obj).resolution; + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_timer_resolution := 0; + End; + End; +End; + +Procedure ptc_timer_assign(obj, timer : TPTC_TIMER); + +Begin + Try + TPTCTimer(obj).ASSign(TPTCTimer(timer)); + Except + On error : TPTCError Do + ptc_exception_handle(error); + End; +End; + +Function ptc_timer_equals(obj, timer : TPTC_TIMER) : Boolean; + +Begin + Try + ptc_timer_equals := TPTCTimer(obj).equals(TPTCTimer(timer)); + Except + On error : TPTCError Do + Begin + ptc_exception_handle(error); + ptc_timer_equals := False; + End; + End; +End; diff --git a/packages/ptc/src/c_api/timerd.inc b/packages/ptc/src/c_api/timerd.inc new file mode 100644 index 0000000000..731eef3ee4 --- /dev/null +++ b/packages/ptc/src/c_api/timerd.inc @@ -0,0 +1,19 @@ +{ setup } +Function ptc_timer_create : TPTC_TIMER; +Procedure ptc_timer_destroy(obj : TPTC_TIMER); + +{ set time } +Procedure ptc_timer_set(obj : TPTC_TIMER; time : Double); + +{ control } +Procedure ptc_timer_start(obj : TPTC_TIMER); +Procedure ptc_timer_stop(obj : TPTC_TIMER); + +{ time data } +Function ptc_timer_time(obj : TPTC_TIMER) : Double; +Function ptc_timer_delta(obj : TPTC_TIMER) : Double; +Function ptc_timer_resolution(obj : TPTC_TIMER) : Double; + +{ operators } +Procedure ptc_timer_assign(obj, timer : TPTC_TIMER); +Function ptc_timer_equals(obj, timer : TPTC_TIMER) : Boolean; diff --git a/packages/ptc/src/cleard.inc b/packages/ptc/src/cleard.inc new file mode 100644 index 0000000000..bcd757fdad --- /dev/null +++ b/packages/ptc/src/cleard.inc @@ -0,0 +1,33 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCClear=Class(TObject) + Private + FHandle : THermesHandle; + FFormat : TPTCFormat; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure Request(Const AFormat : TPTCFormat); + Procedure Clear(APixels : Pointer; + AX, AY, AWidth, AHeight, APitch : Integer; + Const AColor : TPTCColor); + End; diff --git a/packages/ptc/src/cleari.inc b/packages/ptc/src/cleari.inc new file mode 100644 index 0000000000..17e15acbb0 --- /dev/null +++ b/packages/ptc/src/cleari.inc @@ -0,0 +1,141 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCClear.Create; + +Begin + FFormat := Nil; + { initialize hermes } + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + + { default current format } + FFormat := TPTCFormat.Create; + { create hermes clearer instance } + FHandle := Hermes_ClearerInstance; + { check hermes clearer instance } + If FHandle = 0 Then + Raise TPTCError.Create('could not create hermes clearer instance'); +End; + +Destructor TPTCClear.Destroy; + +Begin + { return the clearer instance } + Hermes_ClearerReturn(FHandle); + FFormat.Free; + + { free hermes } + Hermes_Done; + + Inherited Destroy; +End; + +Procedure TPTCClear.Request(Const AFormat : TPTCFormat); + +Var + hermes_format : PHermesFormat; + +Begin + hermes_format := @AFormat.FFormat; + { request surface clear for this format } + If Not Hermes_ClearerRequest(FHandle, hermes_format) Then + Raise TPTCError.Create('unsupported clear format'); + + { update current format } + FFormat.Assign(AFormat); +End; + +Procedure TPTCClear.Clear(APixels : Pointer; AX, AY, AWidth, AHeight, APitch : Integer; Const AColor : TPTCColor); + +Var + r, g, b, a : LongInt; + index : LongInt; + +Begin + If APixels = Nil Then + Raise TPTCError.Create('nil pixels pointer in clear'); + + { check format type } + If FFormat.direct Then + Begin + { check color type } + If Not AColor.direct Then + Raise TPTCError.Create('direct pixel formats can only be cleared with direct color'); + + { setup clear color } + r := Trunc(AColor.R * 255); + g := Trunc(AColor.G * 255); + b := Trunc(AColor.B * 255); + a := Trunc(AColor.A * 255); + + { clamp red } + If r > 255 Then + r := 255 + Else + If r < 0 Then + r := 0; + + { clamp green } + If g > 255 Then + g := 255 + Else + If g < 0 Then + g := 0; + + { clamp blue } + If b > 255 Then + b := 255 + Else + If b < 0 Then + b := 0; + + { clamp alpha } + If a > 255 Then + a := 255 + Else + If a < 0 Then + a := 0; + + { perform the clearing } + Hermes_ClearerClear(FHandle, APixels, AX, AY, AWidth, AHeight, APitch, + r, g, b, a); + End + Else + Begin + { check color type } + If Not AColor.indexed Then + Raise TPTCError.Create('indexed pixel formats can only be cleared with indexed color'); + + { setup clear index } + index := AColor.index; + + { clamp color index } + If index > 255 Then + index := 255 + Else + If index < 0 Then + index := 0; + + { perform the clearing } + Hermes_ClearerClear(FHandle, APixels, AX, AY, AWidth, AHeight, APitch, + 0, 0, 0, index); + End; +End; diff --git a/packages/ptc/src/clipperd.inc b/packages/ptc/src/clipperd.inc new file mode 100644 index 0000000000..c8e9e7799e --- /dev/null +++ b/packages/ptc/src/clipperd.inc @@ -0,0 +1,30 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCClipper=Class(TObject) + Public + { clip a single area against clip area } + Class Function Clip(Const AArea, AClip : TPTCArea) : TPTCArea; + { clip source and destination areas against source and destination clip areas } + Class Procedure Clip(Const ASource, AClipSource, AClippedSource, + ADestination, AClipDestination, + AClippedDestination : TPTCArea); + End; diff --git a/packages/ptc/src/clipperi.inc b/packages/ptc/src/clipperi.inc new file mode 100644 index 0000000000..810f63ed63 --- /dev/null +++ b/packages/ptc/src/clipperi.inc @@ -0,0 +1,264 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{$INLINE ON} + +Class Function TPTCClipper.Clip(Const AArea, AClip : TPTCArea) : TPTCArea; + +Var + left, top, right, bottom : Integer; + clip_left, clip_top, clip_right, clip_bottom : Integer; + +Begin + { get in coordinates } + left := AArea.Left; + top := AArea.Top; + right := AArea.Right; + bottom := AArea.Bottom; + + { get clip coordinates } + clip_left := AClip.Left; + clip_top := AClip.Top; + clip_right := AClip.Right; + clip_bottom := AClip.Bottom; + + { clip left } + If left < clip_left Then + left := clip_left; + If left > clip_right Then + left := clip_right; + + { clip top } + If top < clip_top Then + top := clip_top; + If top > clip_bottom Then + top := clip_bottom; + + { clip right } + If right < clip_left Then + right := clip_left; + If right > clip_right Then + right := clip_right; + + { clip bottom } + If bottom < clip_top Then + bottom := clip_top; + If bottom > clip_bottom Then + bottom := clip_bottom; + + Result := TPTCArea.Create(Left, Top, Right, Bottom); +End; + +{ clip floating point area against a floating point clip area } +Procedure TPTCClipper_clip(Var left, top, right, bottom : Real; + clip_left, clip_top, clip_right, clip_bottom : Real); Inline; + +Begin + { clip left } + If left < clip_left Then + left := clip_left; + If left > clip_right Then + left := clip_right; + { clip top } + If top < clip_top Then + top := clip_top; + If top > clip_bottom Then + top := clip_bottom; + { clip right } + If right < clip_left Then + right := clip_left; + If right > clip_right Then + right := clip_right; + { clip bottom } + If bottom < clip_top Then + bottom := clip_top; + If bottom > clip_bottom Then + bottom := clip_bottom; +End; + +{ clip floating point area against clip area } +Procedure TPTCClipper_clip(Var left, top, right, bottom : Real; Const _clip : TPTCArea); Inline; + +Var + clip_left, clip_top, clip_right, clip_bottom : Real; + +Begin + { get floating point clip area } + clip_left := _clip.left; + clip_top := _clip.top; + clip_right := _clip.right; + clip_bottom := _clip.bottom; + { clip floating point area against floating point clip area } + TPTCClipper_clip(left, top, right, bottom, clip_left, clip_top, clip_right, clip_bottom); +End; + +{ snap a floating point area to integer coordinates } +Procedure TPTCClipper_round(Var left, top, right, bottom : Real); Inline; + +Begin + left := Round(left); + top := Round(top); + right := Round(right); + bottom := Round(bottom); +End; + +Class Procedure TPTCClipper.Clip(Const ASource, AClipSource, AClippedSource, + ADestination, AClipDestination, + AClippedDestination : TPTCArea); + +Var + tmp1, tmp2 : TPTCArea; + + source_left, source_top, source_right, source_bottom : Real; + clipped_source_left, clipped_source_top, clipped_source_right, + clipped_source_bottom : Real; + source_delta_left, source_delta_top, source_delta_right, + source_delta_bottom : Real; + source_to_destination_x, source_to_destination_y : Real; + destination_left, destination_top, destination_right, + destination_bottom : Real; + adjusted_destination_left, adjusted_destination_top, + adjusted_destination_right, adjusted_destination_bottom : Real; + clipped_destination_left, clipped_destination_top, + clipped_destination_right, clipped_destination_bottom : Real; + destination_delta_left, destination_delta_top, destination_delta_right, + destination_delta_bottom : Real; + destination_to_source_x, destination_to_source_y : Real; + adjusted_source_left, adjusted_source_top, adjusted_source_right, + adjusted_source_bottom : Real; + +Begin + tmp1 := Nil; + tmp2 := Nil; + Try + { expand source area to floating point } + source_left := ASource.Left; + source_top := ASource.Top; + source_right := ASource.Right; + source_bottom := ASource.Bottom; + + { setup clipped source area } + clipped_source_left := source_left; + clipped_source_top := source_top; + clipped_source_right := source_right; + clipped_source_bottom := source_bottom; + + { perform clipping on floating point source area } + TPTCClipper_clip(clipped_source_left, clipped_source_top, clipped_source_right, + clipped_source_bottom, AClipSource); + + { check for early source area clipping exit } + If (clipped_source_left = clipped_source_right) Or + (clipped_source_top = clipped_source_bottom) Then + Begin + { clipped area is zero } + tmp1 := TPTCArea.Create(0, 0, 0, 0); + AClippedSource.Assign(tmp1); + AClippedDestination.Assign(tmp1); + Exit; + End; + + { calculate deltas in source clip } + source_delta_left := clipped_source_left - source_left; + source_delta_top := clipped_source_top - source_top; + source_delta_right := clipped_source_right - source_right; + source_delta_bottom := clipped_source_bottom - source_bottom; + + { calculate ratio of source area to destination area } + source_to_destination_x := ADestination.Width / ASource.Width; + source_to_destination_y := ADestination.Height / ASource.Height; + + { expand destination area to floating point } + destination_left := ADestination.Left; + destination_top := ADestination.Top; + destination_right := ADestination.Right; + destination_bottom := ADestination.Bottom; + + { calculate adjusted destination area } + adjusted_destination_left := destination_left + source_delta_left * source_to_destination_x; + adjusted_destination_top := destination_top + source_delta_top * source_to_destination_y; + adjusted_destination_right := destination_right + source_delta_right * source_to_destination_x; + adjusted_destination_bottom := destination_bottom + source_delta_bottom * source_to_destination_y; + + { setup clipped destination area } + clipped_destination_left := adjusted_destination_left; + clipped_destination_top := adjusted_destination_top; + clipped_destination_right := adjusted_destination_right; + clipped_destination_bottom := adjusted_destination_bottom; + + { perform clipping on floating point destination area } + TPTCClipper_clip(clipped_destination_left, clipped_destination_top, + clipped_destination_right, clipped_destination_bottom, AClipDestination); + + { check for early destination area clipping exit } + If (clipped_destination_left = clipped_destination_right) Or + (clipped_destination_top = clipped_destination_bottom) Then + Begin + { clipped area is zero } + tmp1 := TPTCArea.Create(0, 0, 0, 0); + AClippedSource.Assign(tmp1); + AClippedDestination.Assign(tmp1); + Exit; + End; + + { calculate deltas in destination clip } + destination_delta_left := clipped_destination_left - adjusted_destination_left; + destination_delta_top := clipped_destination_top - adjusted_destination_top; + destination_delta_right := clipped_destination_right - adjusted_destination_right; + destination_delta_bottom := clipped_destination_bottom - adjusted_destination_bottom; + + { calculate ratio of destination area to source area } + destination_to_source_x := 1 / source_to_destination_x; + destination_to_source_y := 1 / source_to_destination_y; + + { calculate adjusted source area } + adjusted_source_left := clipped_source_left + destination_delta_left * destination_to_source_x; + adjusted_source_top := clipped_source_top + destination_delta_top * destination_to_source_y; + adjusted_source_right := clipped_source_right + destination_delta_right * destination_to_source_x; + adjusted_source_bottom := clipped_source_bottom + destination_delta_bottom * destination_to_source_y; + + { assign adjusted source to clipped source } + clipped_source_left := adjusted_source_left; + clipped_source_top := adjusted_source_top; + clipped_source_right := adjusted_source_right; + clipped_source_bottom := adjusted_source_bottom; + + { round clipped areas to integer coordinates } + TPTCClipper_round(clipped_source_left, clipped_source_top, + clipped_source_right, clipped_source_bottom); + TPTCClipper_round(clipped_destination_left, clipped_destination_top, + clipped_destination_right, clipped_destination_bottom); + + { construct clipped area rectangles from rounded floating point areas } + tmp1 := TPTCArea.Create(Trunc(clipped_source_left), + Trunc(clipped_source_top), + Trunc(clipped_source_right), + Trunc(clipped_source_bottom)); + tmp2 := TPTCArea.Create(Trunc(clipped_destination_left), + Trunc(clipped_destination_top), + Trunc(clipped_destination_right), + Trunc(clipped_destination_bottom)); + AClippedSource.Assign(tmp1); + AClippedDestination.Assign(tmp2); + Finally + tmp1.Free; + tmp2.Free; + End; +End; diff --git a/packages/ptc/src/colord.inc b/packages/ptc/src/colord.inc new file mode 100644 index 0000000000..a92d581991 --- /dev/null +++ b/packages/ptc/src/colord.inc @@ -0,0 +1,42 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCColor=Class(TObject) + Private + FIndex : Integer; + FRed, FGreen, FBlue, FAlpha : Single; + FDirect : Boolean; + FIndexed : Boolean; + Public + Constructor Create; + Constructor Create(AIndex : Integer); + Constructor Create(ARed, AGreen, ABlue : Single; AAlpha : Single = 1); + Constructor Create(Const AColor : TPTCColor); + Procedure Assign(Const AColor : TPTCColor); + Function Equals(Const AColor : TPTCColor) : Boolean; + Property Index : Integer Read FIndex; + Property R : Single Read FRed; + Property G : Single Read FGreen; + Property B : Single Read FBlue; + Property A : Single Read FAlpha; + Property Direct : Boolean Read FDirect; + Property Indexed : Boolean Read FIndexed; + End; diff --git a/packages/ptc/src/colori.inc b/packages/ptc/src/colori.inc new file mode 100644 index 0000000000..93aea039ce --- /dev/null +++ b/packages/ptc/src/colori.inc @@ -0,0 +1,91 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCColor.Create; + +Begin + FIndexed := False; + FDirect := False; + FIndex := 0; + FRed := 0; + FGreen := 0; + FBlue := 0; + FAlpha := 1; +End; + +Constructor TPTCColor.Create(AIndex : Integer); + +Begin + FIndexed := True; + FDirect := False; + FIndex := AIndex; + FRed := 0; + FGreen := 0; + FBlue := 0; + FAlpha := 1; +End; + +Constructor TPTCColor.Create(ARed, AGreen, ABlue : Single; AAlpha : Single = 1); + +Begin + FIndexed := False; + FDirect := True; + FIndex := 0; + FRed := ARed; + FGreen := AGreen; + FBlue := ABlue; + FAlpha := AAlpha; +End; + +Constructor TPTCColor.Create(Const AColor : TPTCColor); + +Begin + FIndex := AColor.FIndex; + FRed := AColor.FRed; + FGreen := AColor.FGreen; + FBlue := AColor.FBlue; + FAlpha := AColor.FAlpha; + FDirect := AColor.FDirect; + FIndexed := AColor.FIndexed; +End; + +Procedure TPTCColor.Assign(Const AColor : TPTCColor); + +Begin + FIndex := AColor.FIndex; + FRed := AColor.FRed; + FGreen := AColor.FGreen; + FBlue := AColor.FBlue; + FAlpha := AColor.FAlpha; + FDirect := AColor.FDirect; + FIndexed := AColor.FIndexed; +End; + +Function TPTCColor.Equals(Const AColor : TPTCColor) : Boolean; + +Begin + Result := (FIndexed = AColor.FIndexed) And + (FDirect = AColor.FDirect) And + (FIndex = AColor.FIndex) And + (FRed = AColor.FRed) And + (FGreen = AColor.FGreen) And + (FBlue = AColor.FBlue) And + (FAlpha = AColor.FAlpha); +End; diff --git a/packages/ptc/src/consoled.inc b/packages/ptc/src/consoled.inc new file mode 100644 index 0000000000..e8ecf1bc08 --- /dev/null +++ b/packages/ptc/src/consoled.inc @@ -0,0 +1,91 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCConsole=Class(TPTCBaseConsole) + Private + Function ConsoleCreate(index : Integer) : TPTCBaseConsole; + Function ConsoleCreate(Const AName : String) : TPTCBaseConsole; + Procedure check; + console : TPTCBaseConsole; + m_modes : Array[0..1023] Of TPTCMode; + hacky_option_console_flag : Boolean; + Public + Constructor Create; Override; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer = 0); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer = 0); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer = 0); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer = 0); Overload; Override; + + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function Palette : TPTCPalette; Override; + Procedure Clip(Const _area : TPTCArea); Override; + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetPages : Integer; Override; + Function GetArea : TPTCArea; Override; + Function Clip : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/consolei.inc b/packages/ptc/src/consolei.inc new file mode 100644 index 0000000000..e4a67851a2 --- /dev/null +++ b/packages/ptc/src/consolei.inc @@ -0,0 +1,754 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Const + {$IFDEF GO32V2} + ConsoleTypesNumber = 4; + {$ENDIF GO32V2} + {$IFDEF Win32} + ConsoleTypesNumber = 2; + {$ENDIF Win32} + {$IFDEF WinCE} + ConsoleTypesNumber = 2; + {$ENDIF WinCE} + {$IFDEF UNIX} + ConsoleTypesNumber = 1; + {$ENDIF UNIX} + ConsoleTypes : Array[0..ConsoleTypesNumber - 1] Of + Record + ConsoleClass : Class Of TPTCBaseConsole; + Names : Array[1..2] Of String; + End = + ( + {$IFDEF GO32V2} + (ConsoleClass : TVESAConsole; Names : ('VESA', '')), + (ConsoleClass : TVGAConsole; Names : ('VGA', 'Fakemode')), + (ConsoleClass : TCGAConsole; Names : ('CGA', '')), + (ConsoleClass : TTEXTFX2Console; Names : ('TEXTFX2', 'Text')) + {$ENDIF GO32V2} + + {$IFDEF Win32} + (ConsoleClass : TDirectXConsole; Names : ('DirectX', '')), + (ConsoleClass : TGDIConsole; Names : ('GDI', '')) + {$ENDIF Win32} + + {$IFDEF WinCE} + (ConsoleClass : TWinCEGAPIConsole; Names : ('GAPI', '')), + (ConsoleClass : TWinCEGDIConsole; Names : ('GDI', '')) + {$ENDIF WinCE} + + {$IFDEF UNIX} + (ConsoleClass : TX11Console; Names : ('X11', '')) + {$ENDIF UNIX} + ); + +Constructor TPTCConsole.Create; + +Var + I : Integer; + {$IFDEF UNIX} + s : AnsiString; + {$ENDIF UNIX} + +Begin + Inherited Create; + console := Nil; + hacky_option_console_flag := False; + FillChar(m_modes, SizeOf(m_modes), 0); + For I := Low(m_modes) To High(m_modes) Do + m_modes[I] := TPTCMode.Create; + + {$IFDEF UNIX} + configure('/usr/share/ptcpas/ptcpas.conf'); + s := fpgetenv('HOME'); + If s = '' Then + s := '/'; + If s[Length(s)] <> '/' Then + s := s + '/'; + s := s + '.ptcpas.conf'; + configure(s); + {$ENDIF UNIX} + + {$IFDEF Win32} + configure('ptcpas.cfg'); + {$ENDIF Win32} + + {$IFDEF GO32V2} + configure('ptcpas.cfg'); + {$ENDIF GO32V2} + + {$IFDEF WinCE} + {todo: configure WinCE} + {$ENDIF WinCE} +End; + +Destructor TPTCConsole.Destroy; + +Var + I : Integer; + +Begin + close; + console.Free; + For I := Low(m_modes) To High(m_modes) Do + m_modes[I].Free; + Inherited Destroy; +End; + +Procedure TPTCConsole.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, _file); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + option(S); + End; + CloseFile(F); +End; + +Function TPTCConsole.option(Const _option : String) : Boolean; + +Begin + If _option = 'enable logging' Then + Begin + LOG_enabled := True; + option := True; + Exit; + End; + If _option = 'disable logging' Then + Begin + LOG_enabled := False; + option := True; + Exit; + End; + + If Assigned(console) Then + option := console.option(_option) + Else + Begin + console := ConsoleCreate(_option); + If Assigned(console) Then + Begin + hacky_option_console_flag := True; + option := True; + End + Else + option := False; + End; +End; + +Function TPTCConsole.modes : PPTCMode; + +Var + _console : TPTCBaseConsole; + index, mode : Integer; + local : Integer; + _modes : PPTCMode; + tmp : TPTCMode; + +Begin + If Assigned(console) Then + modes := console.modes + Else + Begin + _console := Nil; + index := -1; + mode := 0; + Try + Repeat + Inc(index); + Try + _console := ConsoleCreate(index); + Except + On TPTCError Do Begin + FreeAndNil(_console); + Continue; + End; + End; + If _console = Nil Then + Break; + _modes := _console.modes; + local := 0; + While _modes[local].valid Do + Begin + m_modes[mode].Assign(_modes[local]); + Inc(local); + Inc(mode); + End; + FreeAndNil(_console); + Until False; + Finally + _console.Free; + End; + { todo: strip duplicate modes from list? } + tmp := TPTCMode.Create; + Try + m_modes[mode].Assign(tmp); + Finally + tmp.Free; + End; + modes := m_modes; + End; +End; + +Procedure TPTCConsole.open(Const _title : String; _pages : Integer);{ Overload;} + +Var + composite, tmp : TPTCError; + index : Integer; + success : Boolean; + +Begin + If Assigned(console) Then + Begin + Try + console.open(_title, _pages); + Exit; + Except + On error : TPTCError Do Begin + FreeAndNil(console); + If hacky_option_console_flag Then + Begin + hacky_option_console_flag := False; + Raise TPTCError.Create('could not open console', error); + End; + End; + End; + End; + index := -1; + composite := TPTCError.Create; + success := False; + Try + Repeat + Inc(index); + Try + console := ConsoleCreate(index); + If console = Nil Then + Break; + console.open(_title, _pages); + success := True; + Exit; + Except + On error : TPTCError Do Begin + tmp := TPTCError.Create(error.message, composite); + Try + composite.Assign(tmp); + Finally + tmp.Free; + End; + FreeAndNil(console); + Continue; + End; + End; + Until False; + console := Nil; + Raise TPTCError.Create(composite); + Finally + composite.Free; + If Not success Then + FreeAndNil(console); + End; +End; + +Procedure TPTCConsole.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer);{ Overload;} + +Var + composite, tmp : TPTCError; + index : Integer; + success : Boolean; + +Begin + If Assigned(console) Then + Begin + Try + console.open(_title, _format, _pages); + Exit; + Except + On error : TPTCError Do Begin + FreeAndNil(console); + If hacky_option_console_flag Then + Begin + hacky_option_console_flag := False; + Raise TPTCError.Create('could not open console', error); + End; + End; + End; + End; + index := -1; + composite := TPTCError.Create; + success := False; + Try + Repeat + Inc(index); + Try + console := ConsoleCreate(index); + If console = Nil Then + Break; + console.open(_title, _format, _pages); + success := True; + Exit; + Except + On error : TPTCError Do Begin + tmp := TPTCError.Create(error.message, composite); + Try + composite.Assign(tmp); + Finally + tmp.Free; + End; + FreeAndNil(console); + Continue; + End; + End; + Until False; + console := Nil; + Raise TPTCError.Create(composite); + Finally + composite.Free; + If Not success Then + FreeAndNil(console); + End; +End; + +Procedure TPTCConsole.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer);{ Overload;} + +Var + composite, tmp : TPTCError; + index : Integer; + success : Boolean; + +Begin + If Assigned(console) Then + Begin + Try + console.open(_title, _width, _height, _format, _pages); + Exit; + Except + On error : TPTCError Do Begin + FreeAndNil(console); + If hacky_option_console_flag Then + Begin + hacky_option_console_flag := False; + Raise TPTCError.Create('could not open console', error); + End; + End; + End; + End; + index := -1; + composite := TPTCError.Create; + success := False; + Try + Repeat + Inc(index); + Try + console := ConsoleCreate(index); + If console = Nil Then + Break; + console.open(_title, _width, _height, _format, _pages); + success := True; + Exit; + Except + On error : TPTCError Do Begin + tmp := TPTCError.Create(error.message, composite); + Try + composite.Assign(tmp); + Finally + tmp.Free; + End; + FreeAndNil(console); + Continue; + End; + End; + Until False; + console := Nil; + Raise TPTCError.Create(composite); + Finally + composite.Free; + If Not success Then + FreeAndNil(console); + End; +End; + +Procedure TPTCConsole.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer);{ Overload;} + +Var + composite, tmp : TPTCError; + index : Integer; + success : Boolean; + +Begin + If Assigned(console) Then + Begin + Try + console.open(_title, _mode, _pages); + Exit; + Except + On error : TPTCError Do Begin + FreeAndNil(console); + If hacky_option_console_flag Then + Begin + hacky_option_console_flag := False; + Raise TPTCError.Create('could not open console', error); + End; + End; + End; + End; + index := -1; + composite := TPTCError.Create; + success := False; + Try + Repeat + Inc(index); + Try + console := ConsoleCreate(index); + If console = Nil Then + Break; + console.open(_title, _mode, _pages); + success := True; + Exit; + Except + On error : TPTCError Do Begin + tmp := TPTCError.Create(error.message, composite); + Try + composite.Assign(tmp); + Finally + tmp.Free; + End; + FreeAndNil(console); + Continue; + End; + End; + Until False; + console := Nil; + Raise TPTCError.Create(composite); + Finally + composite.Free; + If Not success Then + FreeAndNil(console); + End; +End; + +Procedure TPTCConsole.close; + +Begin + If Assigned(console) Then + console.close; + hacky_option_console_flag := False; +End; + +Procedure TPTCConsole.flush; + +Begin + check; + console.flush; +End; + +Procedure TPTCConsole.finish; + +Begin + check; + console.finish; +End; + +Procedure TPTCConsole.update; + +Begin + check; + console.update; +End; + +Procedure TPTCConsole.update(Const _area : TPTCArea); + +Begin + check; + console.update(_area); +End; + +Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface); + +Begin + check; + console.copy(surface); +End; + +Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Begin + check; + console.copy(surface, source, destination); +End; + +Function TPTCConsole.lock : Pointer; + +Begin + check; + lock := console.lock; +End; + +Procedure TPTCConsole.unlock; + +Begin + check; + console.unlock; +End; + +Procedure TPTCConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); + +Begin + check; + console.load(pixels, _width, _height, _pitch, _format, _palette); +End; + +Procedure TPTCConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Begin + check; + console.load(pixels, _width, _height, _pitch, _format, _palette, + source, destination); +End; + +Procedure TPTCConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); + +Begin + check; + console.save(pixels, _width, _height, _pitch, _format, _palette); +End; + +Procedure TPTCConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Begin + check; + console.save(pixels, _width, _height, _pitch, _format, _palette, + source, destination); +End; + +Procedure TPTCConsole.clear; + +Begin + check; + console.clear; +End; + +Procedure TPTCConsole.clear(Const color : TPTCColor); + +Begin + check; + console.clear(color); +End; + +Procedure TPTCConsole.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin + check; + console.clear(color, _area); +End; + +Procedure TPTCConsole.palette(Const _palette : TPTCPalette); + +Begin + check; + console.palette(_palette); +End; + +Function TPTCConsole.Palette : TPTCPalette; + +Begin + check; + Result := console.Palette; +End; + +Procedure TPTCConsole.Clip(Const _area : TPTCArea); + +Begin + check; + console.clip(_area); +End; + +Function TPTCConsole.GetWidth : Integer; + +Begin + check; + Result := console.GetWidth; +End; + +Function TPTCConsole.GetHeight : Integer; + +Begin + check; + Result := console.GetHeight; +End; + +Function TPTCConsole.GetPitch : Integer; + +Begin + check; + Result := console.GetPitch; +End; + +Function TPTCConsole.GetPages : Integer; + +Begin + check; + Result := console.GetPages; +End; + +Function TPTCConsole.GetArea : TPTCArea; + +Begin + check; + Result := console.GetArea; +End; + +Function TPTCConsole.Clip : TPTCArea; + +Begin + check; + Result := console.Clip; +End; + +Function TPTCConsole.GetFormat : TPTCFormat; + +Begin + check; + Result := console.GetFormat; +End; + +Function TPTCConsole.GetName : String; + +Begin + Result := ''; + If Assigned(console) Then + Result := console.GetName + Else +{$IFDEF GO32V2} + Result := 'DOS'; +{$ENDIF GO32V2} +{$IFDEF WIN32} + Result := 'Win32'; +{$ENDIF WIN32} +{$IFDEF LINUX} + Result := 'Linux'; +{$ENDIF LINUX} +End; + +Function TPTCConsole.GetTitle : String; + +Begin + check; + Result := console.GetTitle; +End; + +Function TPTCConsole.GetInformation : String; + +Begin + check; + Result := console.GetInformation; +End; + +Function TPTCConsole.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; + +Begin + check; + Result := console.NextEvent(event, wait, EventMask); +End; + +Function TPTCConsole.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; + +Begin + check; + Result := console.PeekEvent(wait, EventMask); +End; + +Function TPTCConsole.ConsoleCreate(index : Integer) : TPTCBaseConsole; + +Begin + Result := Nil; + If (index >= Low(ConsoleTypes)) And (index <= High(ConsoleTypes)) Then + Result := ConsoleTypes[index].ConsoleClass.Create; + + If Result <> Nil Then + Result.KeyReleaseEnabled := KeyReleaseEnabled; +End; + +Function TPTCConsole.ConsoleCreate(Const AName : String) : TPTCBaseConsole; + +Var + I, J : Integer; + +Begin + Result := Nil; + + If AName = '' Then + Exit; + + For I := Low(ConsoleTypes) To High(ConsoleTypes) Do + For J := Low(ConsoleTypes[I].Names) To High(ConsoleTypes[I].Names) Do + If AName = ConsoleTypes[I].Names[J] Then + Begin + Result := ConsoleTypes[I].ConsoleClass.Create; + + If Result <> Nil Then + Begin + Result.KeyReleaseEnabled := KeyReleaseEnabled; + Exit; + End; + End; +End; + +Procedure TPTCConsole.check; + +Begin + { $IFDEF DEBUG} + If console = Nil Then + Raise TPTCError.Create('console is not open (core)'); + { $ENDIF DEBUG} +End; diff --git a/packages/ptc/src/copyd.inc b/packages/ptc/src/copyd.inc new file mode 100644 index 0000000000..c67d9e94a8 --- /dev/null +++ b/packages/ptc/src/copyd.inc @@ -0,0 +1,37 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCCopy=Class(TObject) + Private + Procedure Update; + FHandle : THermesHandle; + FFlags : LongInt; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure Request(Const ASource, ADestination : TPTCFormat); + Procedure Palette(Const ASource, ADestination : TPTCPalette); + Procedure Copy(Const ASourcePixels : Pointer; ASourceX, ASourceY, + ASourceWidth, ASourceHeight, ASourcePitch : Integer; + ADestinationPixels : Pointer; ADestinationX, ADestinationY, + ADestinationWidth, ADestinationHeight, ADestinationPitch : Integer); + Function Option(Const AOption : String) : Boolean; + End; diff --git a/packages/ptc/src/copyi.inc b/packages/ptc/src/copyi.inc new file mode 100644 index 0000000000..ad32cb595d --- /dev/null +++ b/packages/ptc/src/copyi.inc @@ -0,0 +1,127 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCCopy.Create; + +Begin + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + FFlags := HERMES_CONVERT_NORMAL; + FHandle := Hermes_ConverterInstance(FFlags); + If FHandle = 0 Then + Raise TPTCError.Create('could not create hermes converter instance'); +End; + +Destructor TPTCCopy.Destroy; + +Begin + Hermes_ConverterReturn(FHandle); + Hermes_Done; + Inherited Destroy; +End; + +Procedure TPTCCopy.Request(Const ASource, ADestination : TPTCFormat); + +Var + hermes_source_format, hermes_destination_format : PHermesFormat; + +Begin + hermes_source_format := @ASource.FFormat; + hermes_destination_format := @ADestination.FFormat; + If Not Hermes_ConverterRequest(FHandle, hermes_source_format, + hermes_destination_format) Then + Raise TPTCError.Create('unsupported hermes pixel format conversion'); +End; + +Procedure TPTCCopy.Palette(Const ASource, ADestination : TPTCPalette); + +Begin + If Not Hermes_ConverterPalette(FHandle, ASource.m_handle, + ADestination.m_handle) Then + Raise TPTCError.Create('could not set hermes conversion palettes'); +End; + +Procedure TPTCCopy.copy(Const ASourcePixels : Pointer; ASourceX, ASourceY, + ASourceWidth, ASourceHeight, ASourcePitch : Integer; + ADestinationPixels : Pointer; ADestinationX, ADestinationY, + ADestinationWidth, ADestinationHeight, ADestinationPitch : Integer); + +Begin +{$IFDEF DEBUG} +{ + This checking is performed only when DEBUG is defined, + and can be used to track down errors early caused by passing + nil pointers to surface and console functions. + + Even though technicially it is the users responsibility + to ensure that all pointers are non-nil, it is useful + to provide a check here in debug build to prevent such + bugs from ever occuring. + + The checking function also tests that the source and destination + pointers are not the same, a bug that can be caused by copying + a surface to itself. The nature of the copy routine is that + this operation is undefined if the source and destination memory + areas overlap. +} + If ASourcePixels = Nil Then + Raise TPTCError.Create('nil source pointer in copy'); + If ADestinationPixels = Nil Then + Raise TPTCError.Create('nil destination pointer in copy'); + If ASourcePixels = ADestinationPixels Then + Raise TPTCError.Create('identical source and destination pointers in copy'); +{$ELSE DEBUG} + { in release build no checking is performed for the sake of efficiency. } +{$ENDIF DEBUG} + If Not Hermes_ConverterCopy(FHandle, ASourcePixels, ASourceX, ASourceY, + ASourceWidth, ASourceHeight, ASourcePitch, ADestinationPixels, + ADestinationX, ADestinationY, ADestinationWidth, ADestinationHeight, + ADestinationPitch) Then + Raise TPTCError.Create('hermes conversion failure'); +End; + +Function TPTCCopy.Option(Const AOption : String) : Boolean; + +Begin + If (AOption = 'attempt dithering') And ((FFlags And HERMES_CONVERT_DITHER) = 0) Then + Begin + FFlags := FFlags Or HERMES_CONVERT_DITHER; + Update; + Result := True; + Exit; + End; + If (AOption = 'disable dithering') And ((FFlags And HERMES_CONVERT_DITHER) <> 0) Then + Begin + FFlags := FFlags And (Not HERMES_CONVERT_DITHER); + Update; + Result := True; + Exit; + End; + Result := False; +End; + +Procedure TPTCCopy.Update; + +Begin + Hermes_ConverterReturn(FHandle); + FHandle := Hermes_ConverterInstance(FFlags); + If FHandle = 0 Then + Raise TPTCError.Create('could not update hermes converter instance'); +End; diff --git a/packages/ptc/src/coreimplementation.inc b/packages/ptc/src/coreimplementation.inc new file mode 100644 index 0000000000..45d302f65a --- /dev/null +++ b/packages/ptc/src/coreimplementation.inc @@ -0,0 +1,16 @@ +{$INCLUDE errori.inc} +{$INCLUDE areai.inc} +{$INCLUDE colori.inc} +{$INCLUDE formati.inc} +{$INCLUDE eventi.inc} +{$INCLUDE keyeventi.inc} +{$INCLUDE mouseeventi.inc} +{$INCLUDE modei.inc} +{$INCLUDE palettei.inc} +{$INCLUDE cleari.inc} +{$INCLUDE copyi.inc} +{$INCLUDE clipperi.inc} +{$INCLUDE basesurfacei.inc} +{$INCLUDE baseconsolei.inc} +{$INCLUDE surfacei.inc} +{$INCLUDE timeri.inc} diff --git a/packages/ptc/src/coreinterface.inc b/packages/ptc/src/coreinterface.inc new file mode 100644 index 0000000000..34f9682ce7 --- /dev/null +++ b/packages/ptc/src/coreinterface.inc @@ -0,0 +1,17 @@ +{$INCLUDE aread.inc} +{$INCLUDE colord.inc} +{$INCLUDE formatd.inc} +{$INCLUDE eventd.inc} +{$INCLUDE keyeventd.inc} +{$INCLUDE mouseeventd.inc} +{$INCLUDE moded.inc} +{$INCLUDE paletted.inc} +{$INCLUDE cleard.inc} +{$INCLUDE copyd.inc} +{$INCLUDE clipperd.inc} +{$INCLUDE basesurfaced.inc} +{$INCLUDE surfaced.inc} +{$INCLUDE baseconsoled.inc} +{$INCLUDE consoled.inc} +{$INCLUDE errord.inc} +{$INCLUDE timerd.inc} diff --git a/packages/ptc/src/dos/base/kbd.inc b/packages/ptc/src/dos/base/kbd.inc new file mode 100644 index 0000000000..474e5a624f --- /dev/null +++ b/packages/ptc/src/dos/base/kbd.inc @@ -0,0 +1,123 @@ +Constructor TDosKeyboard.Create; + +Begin + { defaults } + m_key := False; + m_head := 0; + m_tail := 0; +End; + +Destructor TDosKeyboard.Destroy; + +Begin + Inherited Destroy; +End; + +Procedure TDosKeyboard.internal_ReadKey(k : TPTCKey); + +Var + read : TPTCKey; + +Begin + While Not ready Do; + read := remove; + Try + k.ASSign(read); + Finally + read.Free; + End; +End; + +Function TDosKeyboard.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + Result := ready; + If Result = True Then + k.ASSign(m_buffer[m_tail]); +End; + +Procedure TDosKeyboard.insert(_key : TPTCKey); + +Begin + { check for overflow } + If (m_head <> (m_tail - 1)) And + ((m_tail <> 0) Or (m_head <> High(m_buffer))) Then + Begin + { insert key at head } + m_buffer[m_head] := _key; + + { increase head } + Inc(m_head); + + { wrap head from end to start } + If m_head > High(m_buffer) Then + m_head := Low(m_buffer); + End; +End; + +Function TDosKeyboard.remove : TPTCKey; + +Begin + { return key data from tail } + remove := m_buffer[m_tail]; + + { increase tail } + Inc(m_tail); + + { wrap tail from end to start } + If m_tail > High(m_buffer) Then + m_tail := Low(m_buffer); +End; + +Function TDosKeyboard.ready : Boolean; + +Var + c : Integer; + Ch, Ex : Char; + +Begin + If KeyPressed Then + Begin + Ch := ReadKey; + If Ch = #0 Then + Ex := ReadKey + Else + Ex := #0; + If Ch <> #0 Then + Begin + Ch := UpCase(Ch); + c := Ord(Ch); + End + Else + Begin + Case Ord(Ex) Of + 59 : c := PTCKEY_F1; + 60 : c := PTCKEY_F2; + 61 : c := PTCKEY_F3; + 62 : c := PTCKEY_F4; + 63 : c := PTCKEY_F5; + 64 : c := PTCKEY_F6; + 65 : c := PTCKEY_F7; + 66 : c := PTCKEY_F8; + 67 : c := PTCKEY_F9; + 68 : c := PTCKEY_F10; + 71 : c := PTCKEY_HOME; + 72 : c := PTCKEY_UP; + 73 : c := PTCKEY_PAGEUP; + 75 : c := PTCKEY_LEFT; + 76 : c := PTCKEY_NUMPAD5; + 77 : c := PTCKEY_RIGHT; + 79 : c := PTCKEY_END; + 80 : c := PTCKEY_DOWN; + 81 : c := PTCKEY_PAGEDOWN; + 82 : c := PTCKEY_INSERT; + 83 : c := PTCKEY_DELETE; + 133 : c := PTCKEY_F11; + 134 : c := PTCKEY_F12; + End; + End; + insert(TPTCKey.Create(c, False, False, False, True)); + insert(TPTCKey.Create(c, False, False, False, False)); + End; + ready := m_head <> m_tail; +End; diff --git a/packages/ptc/src/dos/base/kbdd.inc b/packages/ptc/src/dos/base/kbdd.inc new file mode 100644 index 0000000000..5503981034 --- /dev/null +++ b/packages/ptc/src/dos/base/kbdd.inc @@ -0,0 +1,29 @@ +Type + TDosKeyboard = Class(TObject) + Private + { internal key functions } + Procedure insert(_key : TPTCKey); + Function remove : TPTCKey; + Function ready : Boolean; + + { data } + m_key : Boolean; + + { modifiers } + m_alt : Boolean; + m_shift : Boolean; + m_control : Boolean; + + { key buffer } + m_head : Integer; + m_tail : Integer; + m_buffer : Array[0..1023] Of TPTCKey; + Public + { setup } + Constructor Create; + Destructor Destroy; Override; + + { input } + Procedure internal_ReadKey(k : TPTCKey); + Function internal_PeekKey(k : TPTCKey) : Boolean; + End; diff --git a/packages/ptc/src/dos/cga/cga.pp b/packages/ptc/src/dos/cga/cga.pp new file mode 100644 index 0000000000..bc6f089d81 --- /dev/null +++ b/packages/ptc/src/dos/cga/cga.pp @@ -0,0 +1,441 @@ +{$MODE objfpc} +{$ASMMODE intel} + +Unit CGA; + +Interface + +Procedure CGAText; +Procedure CGA320; +Procedure CGA640; +Procedure CGADump(q : PByte); +Procedure CGASetPalette(palette, border : Integer); +Procedure CGAPrecalc; + +Implementation + +Uses + go32, crt; + +Const + palette : Array[0..15, 0..2] Of Byte = ( + ( 0, 0, 0), ( 0, 0,42), ( 0,42, 0), ( 0,42,42), (42, 0, 0), (42, 0,42), (42,21, 0), (42,42,42), + (21,21,21), (21,21,63), (21,63,21), (21,63,63), (63,21,21), (63,21,63), (63,63,21), (63,63,63)); + cgaback : Array[0..3, 0..12] Of Integer = ( + ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 13, 15), + ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14), + ( 0, 1, 3, 5, 7, 8, 9, 10, 11, 12, 13, 14, 15), + ( 0, 1, 2, 4, 6, 8, 9, 10, 11, 12, 13, 14, 15)); + +Type + Float = Extended; + TCGAVideoBuffer = Array[0..16383] Of Byte; + PCGAPrecalc = ^TCGAPrecalc; + TCGAPrecalc = Array[0..15{r}, 0..15{g}, 0..15{b}, 0..3{y}, 0..3{x}] Of Byte; + PCGAPrecalcError = ^TCGAPrecalcError; + TCGAPrecalcError = Array[0..15{r}, 0..15{g}, 0..15{b}] Of Integer; + +Var + cgapal : Array[0..3] Of Integer; + videobuf : TCGAVideoBuffer; + precalcbuf : Array[0..12, 0..3] Of PCGAPrecalc; {3.25mb} + precalcerror : Array[0..12, 0..3] Of PCGAPrecalcError; {0.8125mb} + error : Integer; + lastpalette, lastback : Integer; + +Procedure CGA320; + +Var + regs : TRealRegs; + +Begin + regs.ax := $0004; + RealIntr($10, regs); + lastpalette := -1; + lastback := -1; +End; + +Procedure CGA640; + +Var + regs : TRealRegs; + +Begin + regs.ax := $0004; + RealIntr($10, regs); +End; + +Procedure CGAText; + +Var + regs : TRealRegs; + +Begin + regs.ax := $0003; + RealIntr($10, regs); +End; + +Procedure CGASetPalette(palette, border : Integer); + +Var + regs : TRealRegs; + +Begin + If (palette = lastpalette) And (border = lastback) Then + Exit; + lastpalette := palette; + lastback := border; + regs.ah := $0B; + regs.bh := 1; + regs.bl := palette And 1; + RealIntr($10, regs); + If (palette And 2) = 0 Then + Inc(border, 16); + regs.ah := $0B; + regs.bh := 0; + regs.bl := border; + RealIntr($10, regs); +End; + +Procedure CGABlitToScreen(p : Pointer); Assembler; + +Asm + mov edi, $B8000 + push es + mov ax, fs + mov es, ax + mov esi, [p] + mov ecx, 16192/4 + rep movsd + pop es +End; + +Function CGACalc2(r, g, b : Integer; dx, dy : Integer; back, pal : Integer) : Integer;{ Inline;} + +Begin + CGACalc2 := precalcbuf[back, pal]^[r Shr 4, g Shr 4, b Shr 4, dy, dx]; +End; + +Procedure CGACalc(r, g, b : Integer; {dx, dy : Integer;} + Var dither, best1, best2 : Integer); + +Var + I, J : Integer; + mindist : Float; + dist : Float; + r1, g1, b1 : Integer; + tmp : Integer; +{ dither : Integer;} {0-none; 1-50%; 2-25%; 3-12.5%; 4-37.5%} + +Begin + r := Round(r*63 / 15); + g := Round(g*63 / 15); + b := Round(b*63 / 15); + mindist := $7FFFFFFF; + For I := 0 To 3 Do + Begin + dist := Sqr(r - palette[cgapal[I], 0]) + + Sqr(g - palette[cgapal[I], 1]) + + Sqr(b - palette[cgapal[I], 2]); + If dist < mindist Then + Begin + mindist := dist; + best1 := I; + dither := 0; + End; + End; + + For J := 0 To 3 Do + Begin + r1 := palette[cgapal[J], 0]; + g1 := palette[cgapal[J], 1]; + b1 := palette[cgapal[J], 2]; + For I := 0 To 3 Do + Begin + If I = J Then + Continue; + dist := Sqr(r - (palette[cgapal[I], 0] + r1)*0.5) + + Sqr(g - (palette[cgapal[I], 1] + g1)*0.5) + + Sqr(b - (palette[cgapal[I], 2] + b1)*0.5); + If dist < mindist Then + Begin + mindist := dist; + best1 := J; + best2 := I; + dither := 1; + End; + dist := Sqr(r - (0.25*palette[cgapal[I], 0] + 0.75*r1)) + + Sqr(g - (0.25*palette[cgapal[I], 1] + 0.75*g1)) + + Sqr(b - (0.25*palette[cgapal[I], 2] + 0.75*b1)); + If dist < mindist Then + Begin + mindist := dist; + best1 := J; + best2 := I; + dither := 2; + End; + dist := Sqr(r - (0.125*palette[cgapal[I], 0] + 0.875*r1)) + + Sqr(g - (0.125*palette[cgapal[I], 1] + 0.875*g1)) + + Sqr(b - (0.125*palette[cgapal[I], 2] + 0.875*b1)); + If dist < mindist Then + Begin + mindist := dist; + best1 := J; + best2 := I; + dither := 3; + End; + dist := Sqr(r - (0.375*palette[cgapal[I], 0] + 0.625*r1)) + + Sqr(g - (0.375*palette[cgapal[I], 1] + 0.625*g1)) + + Sqr(b - (0.375*palette[cgapal[I], 2] + 0.625*b1)); + If dist < mindist Then + Begin + mindist := dist; + best1 := J; + best2 := I; + dither := 4; + End; + End; + End; + + error:=error+round(Sqrt(mindist) * 290); + Case dither Of + 0 : best2 := best1; + 1 : Begin + If best1 > best2 Then + Begin + tmp := best1; + best1 := best2; + best2 := tmp; + End; + End; + End; +End; + +Function CGACalcError(s : PByte; back, pal : Integer) : Integer; + +Var + X, Y : Integer; + r, g, b : Integer; + +Begin + CGACalcError := 0; + For Y := 0 To 199 {Div 4} Do + Begin + For X := 0 To 319 {Div 4} Do + Begin + b := s[0]; + g := s[1]; + r := s[2]; + inc(CGACalcError,precalcerror[back, pal]^[b Shr 4, g Shr 4, r Shr 4]); + Inc(s, 4{ + 4 + 4 + 4}); + End; +// Inc(s, 320*4*3); + End; +End; + +Procedure CGADump2(s, d : PByte; back, pal : Integer); + +Var + I : Integer; + src, dest : PByte; + X, Y : Integer; + r1, g1, b1 : Integer; + r2, g2, b2 : Integer; + r3, g3, b3 : Integer; + r4, g4, b4 : Integer; + +Begin + error := 0; + src := s; + dest := d; + For Y := 0 To 99 Do + Begin + For X := 0 To 79 Do + Begin + b1 := src[0]; + g1 := src[1]; + r1 := src[2]; + b2 := src[4]; + g2 := src[5]; + r2 := src[6]; + b3 := src[8]; + g3 := src[9]; + r3 := src[10]; + b4 := src[12]; + g4 := src[13]; + r4 := src[14]; + dest^ := (CGACalc2(r1, g1, b1, 0, (Y And 1) Shl 1, back, pal) Shl 6) Or + (CGACalc2(r2, g2, b2, 1, (Y And 1) Shl 1, back, pal) Shl 4) Or + (CGACalc2(r3, g3, b3, 2, (Y And 1) Shl 1, back, pal) Shl 2) Or + (CGACalc2(r4, g4, b4, 3, (Y And 1) Shl 1, back, pal)); + + Inc(src, 4*4); + Inc(dest); + End; + Inc(src, 320*4); + End; + src := s + 320*4; + dest := d + 8192; + For Y := 0 To 99 Do + Begin + For X := 0 To 79 Do + Begin + b1 := src[0]; + g1 := src[1]; + r1 := src[2]; + b2 := src[4]; + g2 := src[5]; + r2 := src[6]; + b3 := src[8]; + g3 := src[9]; + r3 := src[10]; + b4 := src[12]; + g4 := src[13]; + r4 := src[14]; + dest^ := (CGACalc2(r1, g1, b1, 0, ((Y And 1) Shl 1) + 1, back, pal) Shl 6) Or + (CGACalc2(r2, g2, b2, 1, ((Y And 1) Shl 1) + 1, back, pal) Shl 4) Or + (CGACalc2(r3, g3, b3, 2, ((Y And 1) Shl 1) + 1, back, pal) Shl 2) Or + (CGACalc2(r4, g4, b4, 3, ((Y And 1) Shl 1) + 1, back, pal)); + + Inc(src, 4*4); + Inc(dest); + End; + Inc(src, 320*4); + End; +End; + +Procedure CGADump(q : PByte); + +Var + pal, back : Integer; + bestpal, bestback : Integer; + besterror : Integer; + +Begin + besterror := $7FFFFFFF; + For pal := 0 To 3 Do + Begin + For back := 0 To 12 Do + Begin + error := CGACalcError(q, back, pal); + If error < besterror Then + Begin + besterror := error; + bestpal := pal; + bestback := back; + End; + End; + End; + + CGADump2(q, videobuf, bestback, bestpal); + + CGASetPalette(bestpal, cgaback[bestpal, bestback]); + CGABlitToScreen(@videobuf); +End; + +Procedure CGAPrecalc; + +Var + pal, back : Integer; + r, g, b : Integer; + x, y : Integer; + dither : Integer; + best1, best2 : Integer; + res : Integer; + +Begin + For pal := 0 To 3 Do + Begin + Case pal Of + 0 : Begin + cgapal[1] := 10; + cgapal[2] := 12; + cgapal[3] := 14; + End; + 1 : Begin + cgapal[1] := 11; + cgapal[2] := 13; + cgapal[3] := 15; + End; + 2 : Begin + cgapal[1] := 2; + cgapal[2] := 4; + cgapal[3] := 6; + End; + 3 : Begin + cgapal[1] := 3; + cgapal[2] := 5; + cgapal[3] := 7; + End; + End; + For back := 0 To 12 Do + Begin + If (precalcbuf[back, pal] = Nil) And (precalcerror[back, pal] = Nil) Then + Begin + New(precalcbuf[back, pal]); + New(precalcerror[back, pal]); + End + Else + Continue; + + cgapal[0] := cgaback[pal, back]; + error := 0; + Write(pal, back:3, ' '); + TextAttr := cgapal[0]; + Write('*'); + TextAttr := cgapal[1]; + Write('*'); + TextAttr := cgapal[2]; + Write('*'); + TextAttr := cgapal[3]; + Writeln('*'); + TextAttr := 7; + For r := 0 To 15 Do + For g := 0 To 15 Do + For b := 0 To 15 Do + Begin + error := 0; + CGACalc(r, g, b, dither, best1, best2); + precalcerror[back, pal]^[r, g, b] := error; + For y := 0 To 3 Do + For x := 0 To 3 Do + Begin + Case dither Of + 0 : res := best1; + 1 : Begin + If ((x + y) And 1) <> 0 Then + res := best1 + Else + res := best2; + End; + 2 : Begin + If ((x And 1) = 0) And ((y And 1) = 0) Then + res := best2 + Else + res := best1; + End; + 3 : Begin + If (x = y) And ((x And 1) = 0) Then + res := best2 + Else + res := best1; + End; + 4 : Begin + If (((x And 1) = 0) And ((y And 1) = 0)) Or (x = y) Then + res := best2 + Else + res := best1; + End; + End; + precalcbuf[back, pal]^[r, g, b, y, x] := res; + End; + End; + //Function CGACalc(r, g, b : Integer; dx, dy : Integer) : Integer; + End; + End; +End; + +Begin + FillChar(precalcbuf, SizeOf(precalcbuf), 0); + FillChar(precalcerror, SizeOf(precalcerror), 0); +End. diff --git a/packages/ptc/src/dos/cga/console.inc b/packages/ptc/src/dos/cga/console.inc new file mode 100644 index 0000000000..1713121974 --- /dev/null +++ b/packages/ptc/src/dos/cga/console.inc @@ -0,0 +1,600 @@ +{$MACRO ON} + +{$DEFINE DEFAULT_WIDTH:=320} +{$DEFINE DEFAULT_HEIGHT:=200} +{$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)} + +Constructor CGAConsole.Create; + +Var + I : Integer; + +Begin +{ m_160x100buffer := Nil;} + m_primary := Nil; + m_keyboard := Nil; + m_copy := Nil; + m_default_format := Nil; + m_open := False; + m_locked := False; + FillChar(m_modes, SizeOf(m_modes), 0); + m_title[0] := #0; + m_information[0] := #0; + m_default_width := DEFAULT_WIDTH; + m_default_height := DEFAULT_HEIGHT; + m_default_format := DEFAULT_FORMAT; + + + For I := 0 To 255 Do + m_modes[I] := TPTCMode.Create; + + calcpal := @calcpal_colorbase; + use_charset := @charset_b7asc; + build_colormap(0); + m_copy := TPTCCopy.Create; + configure('ptc.cfg'); +End; + +Destructor CGAConsole.Destroy; + +Var + I : Integer; + +Begin + close; + For I := 0 To 255 Do + If m_modes[I] <> Nil Then + m_modes[I].Destroy; + If m_keyboard <> Nil Then + m_keyboard.Destroy; + If m_copy <> Nil Then + m_copy.Destroy; + If m_default_format <> Nil Then + m_default_format.Destroy; + Inherited Destroy; +End; + +Procedure CGAConsole.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + ASSign(F, _file); + Try + Reset(F); + Except + Exit; + End; + Try + While Not EoF(F) Do + Begin + Readln(F, S); + option(S); + End; + Finally + CloseFile(F); + End; +End; + +Function CGAConsole.option(Const _option : String) : Boolean; + +Begin + {...} + option := m_copy.option(_option); +End; + +Function CGAConsole.modes : PPTCMode; + +Begin + {todo...} + modes := @m_modes; +End; + +Procedure CGAConsole.open(Const _title : String; _pages : Integer); Overload; + +Begin + open(_title, m_default_format, _pages); +End; + +Procedure CGAConsole.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; + +Begin + open(_title, m_default_width, m_default_height, _format, _pages); +End; + +Procedure CGAConsole.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; + +Var + m : TPTCMode; + +Begin + m := TPTCMode.Create(_width, _height, _format); + open(_title, m, _pages); + m.Destroy; +End; + +Procedure CGAConsole.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; + +Var + _width, _height : Integer; + _format : TPTCFormat; + +Begin + If Not _mode.valid Then + Raise TPTCError.Create('invalid mode'); + _width := _mode.width; + _height := _mode.height; + _format := _mode.format; + internal_pre_open_setup(_title); + internal_open_fullscreen_start; + internal_open_fullscreen(_width, _height, _format); + internal_open_fullscreen_finish(_pages); + internal_post_open_setup; +End; + +Procedure CGAConsole.close; + +Begin + If m_open Then + Begin + If m_locked Then + Raise TPTCError.Create('console is still locked'); + {flush all key presses} + While KeyPressed Do ReadKey; + internal_close; + m_open := False; + End; +End; + +Procedure CGAConsole.flush; + +Begin + check_open; + check_unlocked; +End; + +Procedure CGAConsole.finish; + +Begin + check_open; + check_unlocked; +End; + +Procedure CGAConsole.update; + +Var + framebuffer : PByte; + +Begin + check_open; + check_unlocked; + framebuffer := m_primary.lock; +{ vrc;} + CGADump(framebuffer); + m_primary.unlock; +End; + +Procedure CGAConsole.update(Const _area : TPTCArea); + +Begin + update; +End; + +Procedure CGAConsole.internal_ReadKey(k : TPTCKey); + +Begin + check_open; + m_keyboard.internal_ReadKey(k); +End; + +Function CGAConsole.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + check_open; + Result := m_keyboard.internal_PeekKey(k); +End; + +Procedure CGAConsole.copy(Var surface : TPTCBaseSurface); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Procedure CGAConsole.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Begin +End; + +Function CGAConsole.lock : Pointer; + +Var + pixels : Pointer; + +Begin + check_open; + If m_locked Then + Raise TPTCError.Create('console is already locked'); + pixels := m_primary.lock; + m_locked := True; + lock := pixels; +End; + +Procedure CGAConsole.unlock; + +Begin + check_open; + If Not m_locked Then + Raise TPTCError.Create('console is not locked'); + m_primary.unlock; + m_locked := False; +End; + +Procedure CGAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + c, a : TPTCArea; + +Begin + c := clip; a := area; + If (c.left = a.left) And + (c.top = a.top) And + (c.right = a.right) And + (c.bottom = a.bottom) Then + Begin + check_open; + check_unlocked; + console_pixels := lock; + Try + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0, + width, height, pitch); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + load(pixels, _width, _height, _pitch, _format, _palette, Area_, area); + Area_.Destroy; + End; +End; + +Procedure CGAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + console_pixels := lock; + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination); + tmp.Destroy; + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch); + unlock; + Except + On error:TPTCError Do + Begin + clipped_source.Destroy; + clipped_destination.Destroy; + unlock; + Raise TPTCError.Create('failed to load pixels to console area', error); + End; + End; + clipped_source.Destroy; + clipped_destination.Destroy; +End; + +Procedure CGAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + c, a : TPTCArea; + +Begin + c := clip; a := area; + If (c.left = a.left) And + (c.top = a.top) And + (c.right = a.right) And + (c.bottom = a.bottom) Then + Begin + check_open; + check_unlocked; + console_pixels := lock; + Try + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0, + _width, _height, _pitch); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to save console pixels', error); + End; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + save(pixels, _width, _height, _pitch, _format, _palette, area, Area_); + Area_.Destroy; + End; +End; + +Procedure CGAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + console_pixels := lock; + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination); + tmp.Destroy; + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch, + pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch); + unlock; + Except + On error:TPTCError Do + Begin + clipped_source.Destroy; + clipped_destination.Destroy; + unlock; + Raise TPTCError.Create('failed to save console area pixels', error); + End; + End; + clipped_source.Destroy; + clipped_destination.Destroy; +End; + +Procedure CGAConsole.clear; + +Begin +End; + +Procedure CGAConsole.clear(Const color : TPTCColor); + +Begin +End; + +Procedure CGAConsole.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin +End; + +Procedure CGAConsole.palette(Const _palette : TPTCPalette); + +Begin + check_open; + m_primary.palette(_palette); +End; + +Function CGAConsole.palette : TPTCPalette; + +Begin + check_open; + palette := m_primary.palette; +End; + +Procedure CGAConsole.clip(Const _area : TPTCArea); + +Begin + check_open; + m_primary.clip(_area); +End; + +Function CGAConsole.width : Integer; + +Begin + check_open; + width := m_primary.width; +End; + +Function CGAConsole.height : Integer; + +Begin + check_open; + height := m_primary.height; +End; + +Function CGAConsole.pitch : Integer; + +Begin + check_open; + pitch := m_primary.pitch; +End; + +Function CGAConsole.pages : Integer; + +Begin + check_open; + pages := 1;{m_primary.pages;} +End; + +Function CGAConsole.area : TPTCArea; + +Begin + check_open; + area := m_primary.area; +End; + +Function CGAConsole.clip : TPTCArea; + +Begin + check_open; + clip := m_primary.clip; +End; + +Function CGAConsole.format : TPTCFormat; + +Begin + check_open; + format := m_primary.format; +End; + +Function CGAConsole.name : String; + +Begin +End; + +Function CGAConsole.title : String; + +Begin +End; + +Function CGAConsole.information : String; + +Begin +End; + +Procedure CGAConsole.internal_pre_open_setup(Const _title : String); + +Begin + +End; + +Procedure CGAConsole.internal_open_fullscreen_start; + +Var + f : TPTCFormat; + +Begin + CGAPrecalc; + f := TPTCFormat.Create(32, $FF0000, $00FF00, $0000FF); + m_primary := TPTCSurface.Create(320, 200, f); + f.Destroy; +{ set80x50;} + CGA320; +End; + +Procedure CGAConsole.internal_open_fullscreen(_width, _height : Integer; Const _format : TPTCFormat); + +Begin +{ m_primary := TPTCSurface.Create(_width, _height, _format);} +End; + +Procedure CGAConsole.internal_open_fullscreen_finish(_pages : Integer); + +Begin +End; + +Procedure CGAConsole.internal_post_open_setup; + +Begin + If m_keyboard <> Nil Then + m_keyboard.Destroy; + m_keyboard := TDosKeyboard.Create; + { create win32 keyboard + m_keyboard = new DosKeyboard();//m_window->handle(),m_window->thread(),false);} + + { temporary platform dependent information fudge } + {sprintf(m_information,"dos version x.xx.x\nvesa version x.xx\nvesa driver name xxxxx\ndisplay driver vendor xxxxx\ncertified driver? x\n");} + + { set open flag } + m_open := True; +End; + +Procedure CGAConsole.internal_reset; + +Begin + If m_primary <> Nil Then + m_primary.Destroy; +{ m_keyboard.Destroy;} + m_primary := Nil; +{ m_keyboard := Nil;} +End; + +Procedure CGAConsole.internal_close; + +Begin + If m_primary <> Nil Then + m_primary.Destroy; + m_primary := Nil; +{ If m_160x100buffer <> Nil Then + m_160x100buffer.Destroy; + m_160x100buffer := Nil;} + CGAText; +{ m_keyboard.Destroy; + m_keyboard := Nil;} +End; + +Procedure CGAConsole.check_open; + +Begin + {$IFDEF DEBUG} + If Not m_open Then + Raise TPTCError.Create('console is not open'); + {$ENDIF} +End; + +Procedure CGAConsole.check_unlocked; + +Begin + {$IFDEF DEBUG} + If m_locked Then + Raise TPTCError.Create('console is not unlocked'); + {$ENDIF} +End; diff --git a/packages/ptc/src/dos/cga/consoled.inc b/packages/ptc/src/dos/cga/consoled.inc new file mode 100644 index 0000000000..bcc58c6f47 --- /dev/null +++ b/packages/ptc/src/dos/cga/consoled.inc @@ -0,0 +1,100 @@ +Type + CGAConsole = Class(TPTCBaseConsole) + Private + { internal console management routines } + Procedure internal_pre_open_setup(Const _title : String); + Procedure internal_open_fullscreen_start; + Procedure internal_open_fullscreen(_width, _height : Integer; Const _format : TPTCFormat); + Procedure internal_open_fullscreen_finish(_pages : Integer); + Procedure internal_post_open_setup; + Procedure internal_reset; + Procedure internal_close; + + { console debug checks } + Procedure check_open; + Procedure check_unlocked; + + { data } + m_modes : Array[0..255] Of TPTCMode; + m_title : Array[0..1023] Of Char; + m_information : Array[0..1023] Of Char; + + { flags } + m_open : Boolean; + m_locked : Boolean; + + { option data } + m_default_width : Integer; + m_default_height : Integer; + m_default_pages : Integer; + m_default_format : TPTCFormat; + + { objects } + m_copy : TPTCCopy; + + { Dos objects } + m_keyboard : TDosKeyboard; + m_primary : TPTCSurface; +{ m_160x100buffer : TPTCSurface;} + Protected + Procedure internal_ReadKey(k : TPTCKey); Override; + Function internal_PeekKey(k : TPTCKey) : Boolean; Override; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; Override; + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function width : Integer; Override; + Function height : Integer; Override; + Function pitch : Integer; Override; + Function pages : Integer; Override; + Function area : TPTCArea; Override; + Function clip : TPTCArea; Override; + Function format : TPTCFormat; Override; + Function name : String; Override; + Function title : String; Override; + Function information : String; Override; + End; diff --git a/packages/ptc/src/dos/fakemode/console.inc b/packages/ptc/src/dos/fakemode/console.inc new file mode 100644 index 0000000000..b9cd5a999f --- /dev/null +++ b/packages/ptc/src/dos/fakemode/console.inc @@ -0,0 +1,806 @@ +{$MACRO ON} + +{$DEFINE DEFAULT_WIDTH:=320} +{$DEFINE DEFAULT_HEIGHT:=200} +{$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)} + +{$ASMMODE intel} + +Constructor VGAConsole.Create; + +Var +{ I, J : Integer; + r, g, b, a : DWord; + tmpbpp : Integer;} + tmp : TPTCFormat; + +Begin + m_area := Nil; + m_clip := Nil; + m_keyboard := Nil; + m_copy := Nil; + m_palette := Nil; + m_default_format := Nil; + m_open := False; + m_locked := False; + m_title[0] := #0; + m_information[0] := #0; + m_default_width := DEFAULT_WIDTH; + m_default_height := DEFAULT_HEIGHT; + m_default_format := DEFAULT_FORMAT; + +{ InitVESA;} + m_primary := Nil; +{ m_modes[0].Create;} + + m_area := TPTCArea.Create; + m_clip := TPTCArea.Create; + m_copy := TPTCCopy.Create; + m_palette := TPTCPalette.Create; + + tmp := TPTCFormat.Create(8); + m_modes[0] := TPTCMode.Create(320, 200, tmp); + tmp.Destroy; + tmp := TPTCFormat.Create(8, $E0, $1C, $03); + m_modes[1] := TPTCMode.Create(320, 200, tmp); + tmp.Destroy; + tmp := TPTCFormat.Create(16, $F800, $7E0, $1F); + m_modes[2] := TPTCMode.Create(320, 200, tmp); + tmp.Destroy; + m_modes[3] := TPTCMode.Create; + m_faketype := FAKEMODE2A; + + configure('ptc.cfg'); +End; + +Destructor VGAConsole.Destroy; + +Begin + close; + internal_clear_mode_list; + If m_keyboard <> Nil Then + m_keyboard.Destroy; + If m_copy <> Nil Then + m_copy.Destroy; + If m_default_format <> Nil Then + m_default_format.Destroy; + If m_palette <> Nil Then + m_palette.Destroy; + If m_clip <> Nil Then + m_clip.Destroy; + If m_area <> Nil Then + m_area.Destroy; + Inherited Destroy; +End; + +Procedure VGAConsole.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + ASSign(F, _file); + Try + Reset(F); + Except + Exit; + End; + Try + While Not EoF(F) Do + Begin + Readln(F, S); + option(S); + End; + Finally + CloseFile(F); + End; +End; + +Function VGAConsole.option(Const _option : String) : Boolean; + +Begin + {...} + If (System.Copy(_option, 1, 8) = 'FAKEMODE') And (Length(_option) = 10) And + (_option[9] >= '1') And (_option[9] <= '3') And + (_option[10] >= 'A') And (_option[10] <= 'C') Then + Begin + Case _option[9] Of + '1' : Case _option[10] Of + 'A' : m_faketype := FAKEMODE1A; + 'B' : m_faketype := FAKEMODE1B; + 'C' : m_faketype := FAKEMODE1C; + End; + '2' : Case _option[10] Of + 'A' : m_faketype := FAKEMODE2A; + 'B' : m_faketype := FAKEMODE2B; + 'C' : m_faketype := FAKEMODE2C; + End; + '3' : Case _option[10] Of + 'A' : m_faketype := FAKEMODE3A; + 'B' : m_faketype := FAKEMODE3B; + 'C' : m_faketype := FAKEMODE3C; + End; + End; + option := True; + Exit; + End; + option := m_copy.option(_option); +End; + +Procedure VGAConsole.internal_clear_mode_list; + +Var + I : Integer; + Done : Boolean; + +Begin + I := 0; + Done := False; + Repeat + Done := Not m_modes[I].valid; + m_modes[I].Destroy; + Inc(I); + Until Done; +End; + +Function VGAConsole.modes : PPTCMode; + +Begin +{ internal_clear_mode_list;} + + modes := m_modes; +End; + +Procedure VGAConsole.open(Const _title : String; _pages : Integer); Overload; + +Begin + open(_title, m_default_format, _pages); +End; + +Procedure VGAConsole.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; + +Begin + open(_title, m_default_width, m_default_height, _format, _pages); +End; + +Procedure VGAConsole.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; + +Var + m : TPTCMode; + +Begin + m := TPTCMode.Create(_width, _height, _format); + Try + open(_title, m, _pages); + Finally + m.Destroy; + End; +End; + +Procedure VGAConsole.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; + +Var +{ _width, _height : Integer; + _format : TPTCFormat;} + I : Integer; +{ modefound : Integer;} + modetype : Integer; + +Begin + If Not _mode.valid Then + Raise TPTCError.Create('invalid mode'); + If _mode.format.indexed Then + modetype := INDEX8 + Else + If _mode.format.bits = 8 Then + modetype := RGB332 + Else + modetype := FAKEMODE; + internal_pre_open_setup(_title); + internal_open_fullscreen_start; + internal_open_fullscreen(modetype); + internal_open_fullscreen_finish(_pages); + internal_post_open_setup; +End; + +Procedure VGAConsole.close; + +Begin + If m_open Then + Begin + If m_locked Then + Raise TPTCError.Create('console is still locked'); + { flush all key presses } + While KeyPressed Do ReadKey; + internal_close; + m_open := False; + End; +End; + +Procedure VGAConsole.flush; + +Begin + check_open; + check_unlocked; +End; + +Procedure VGAConsole.finish; + +Begin + check_open; + check_unlocked; +End; + +Procedure VGAConsole.vga_load(data : Pointer); ASSembler; + +Asm + push es + mov ax, fs + mov es, ax + mov ecx, 64000/4 + mov esi, [data] + mov edi, 0A0000h + cld + rep movsd + pop es +End; + +Procedure VGAConsole.update; + +Var + framebuffer : PInteger; + +Begin + check_open; + check_unlocked; + Case m_CurrentMode Of + 0, 1 : Begin + While (inportb($3DA) And 8) <> 0 Do; + While (inportb($3DA) And 8) = 0 Do; + vga_load(m_primary); + End; + 2 : fakemode_load(m_primary, True); + End; +{ WriteToVideoMemory(m_primary, 0, m_pitch * m_height);} +End; + +Procedure VGAConsole.update(Const _area : TPTCArea); + +Begin + update; +End; + +Procedure VGAConsole.internal_ReadKey(k : TPTCKey); + +Begin + check_open; + m_keyboard.internal_ReadKey(k); +End; + +Function VGAConsole.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + check_open; + Result := m_keyboard.internal_PeekKey(k); +End; + +Procedure VGAConsole.copy(Var surface : TPTCBaseSurface); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Procedure VGAConsole.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette, source, destination); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Function VGAConsole.lock : Pointer; + +Var + pixels : Pointer; + +Begin + check_open; + If m_locked Then + Raise TPTCError.Create('console is already locked'); + pixels := m_primary; + m_locked := True; + lock := pixels; +End; + +Procedure VGAConsole.unlock; + +Begin + check_open; + If Not m_locked Then + Raise TPTCError.Create('console is not locked'); + m_locked := False; +End; + +Procedure VGAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + check_open; + check_unlocked; + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0, + width, height, pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + load(pixels, _width, _height, _pitch, _format, _palette, Area_, area); + Finally + Area_.Destroy; + End; + End; +End; + +Procedure VGAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination); + Finally + tmp.Destroy; + End; + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console area', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Destroy; + If clipped_destination <> Nil Then + clipped_destination.Destroy; + End; +End; + +Procedure VGAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + check_open; + check_unlocked; + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0, + _width, _height, _pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to save console pixels', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + save(pixels, _width, _height, _pitch, _format, _palette, area, Area_); + Finally + Area_.Destroy; + End; + End; +End; + +Procedure VGAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination); + Finally + tmp.Destroy; + End; + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch, + pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to save console area pixels', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Destroy; + If clipped_destination <> Nil Then + clipped_destination.Destroy; + End; +End; + +Procedure VGAConsole.clear; + +Var + tmp : TPTCColor; + +Begin + check_open; + check_unlocked; + If format.direct Then + tmp := TPTCColor.Create(0, 0, 0, 0) + Else + tmp := TPTCColor.Create(0); + Try + clear(tmp); + Finally + tmp.Destroy; + End; +End; + +Procedure VGAConsole.clear(Const color : TPTCColor); + +Var + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + tmp := TPTCArea.Create; + Try + clear(color, tmp); + Finally + tmp.Destroy; + End; +End; + +Procedure VGAConsole.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin + {...} +End; + +Procedure VGAConsole.palette(Const _palette : TPTCPalette); + +Begin + check_open; + If format.indexed Then + Begin + m_palette.load(_palette.data); + internal_SetPalette(_palette.data); + End; +End; + +Function VGAConsole.palette : TPTCPalette; + +Begin + check_open; + palette := m_palette; +End; + +Procedure VGAConsole.clip(Const _area : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + check_open; + tmp := TPTCClipper.clip(_area, m_area); + Try + m_clip.ASSign(tmp); + Finally + tmp.Destroy; + End; +End; + +Function VGAConsole.width : Integer; + +Begin + check_open; + width := m_width; +End; + +Function VGAConsole.height : Integer; + +Begin + check_open; + height := m_height; +End; + +Function VGAConsole.pitch : Integer; + +Begin + check_open; + pitch := m_pitch; +End; + +Function VGAConsole.pages : Integer; + +Begin + check_open; + pages := 2;{m_primary.pages;} +End; + +Function VGAConsole.area : TPTCArea; + +Begin + check_open; + area := m_area; +End; + +Function VGAConsole.clip : TPTCArea; + +Begin + check_open; + clip := m_clip; +End; + +Function VGAConsole.format : TPTCFormat; + +Begin + check_open; + format := m_modes[m_CurrentMode].format; +End; + +Function VGAConsole.name : String; + +Begin + name := 'VGA'; +End; + +Function VGAConsole.title : String; + +Begin +End; + +Function VGAConsole.information : String; + +Begin +End; + +Procedure VGAConsole.internal_pre_open_setup(Const _title : String); + +Begin + +End; + +Procedure VGAConsole.internal_open_fullscreen_start; + +{Var + f : TPTCFormat;} + +Begin +{ f := TPTCFormat.Create(32, $0000FF, $00FF00, $FF0000);} +{ m_160x100buffer := TPTCSurface.Create(160, 100, f);} +{ f.Destroy;} +{ set80x50;} +End; + +Procedure VGAConsole.internal_open_fullscreen(ModeType : Integer); + +Var + tmp : TPTCArea; + +Begin + VGASetMode(320, 200, ModeType, m_faketype); + Case ModeType Of + INDEX8 : Begin + m_CurrentMode := 0; + m_pitch := 320; + End; + RGB332 : Begin + m_CurrentMode := 1; + m_pitch := 320; + End; + FAKEMODE : Begin + m_CurrentMode := 2; + m_pitch := 640; + End; + End; + m_width := 320; + m_height := 200; + + tmp := TPTCArea.Create(0, 0, width, height); + Try + m_area.ASSign(tmp); + m_clip.ASSign(tmp); + Finally + tmp.Destroy; + End; +End; + +Procedure VGAConsole.internal_open_fullscreen_finish(_pages : Integer); + +Begin + If m_primary <> Nil Then + FreeMem(m_primary); + m_primary := GetMem(m_height * m_pitch); +End; + +Procedure VGAConsole.internal_post_open_setup; + +Begin + If m_keyboard <> Nil Then + m_keyboard.Destroy; + m_keyboard := TDosKeyboard.Create; + + { temporary platform dependent information fudge } + {sprintf(m_information,"dos version x.xx.x\nvesa version x.xx\nvesa driver name xxxxx\ndisplay driver vendor xxxxx\ncertified driver? x\n");} + + { set open flag } + m_open := True; +End; + +Procedure VGAConsole.internal_reset; + +Begin + If m_primary <> Nil Then + FreeMem(m_primary); + m_primary := Nil; + If m_keyboard <> Nil Then + m_keyboard.Destroy; + m_keyboard := Nil; +{ m_primary.Destroy;} +{ m_keyboard.Destroy;} +{ m_primary := Nil;} +{ m_keyboard := Nil;} +End; + +Procedure VGAConsole.internal_close; + +Begin + If m_primary <> Nil Then + Begin + FreeMem(m_primary); + m_primary := Nil; + End; + RestoreTextMode; +End; + +Procedure VGAConsole.internal_SetPalette(data : Pint32); + +Var + i : Integer; + c : DWord; + +Begin + outportb($3C8, 0); + For i := 0 To 255 Do + Begin + c := (data^ Shr 2) And $003F3F3F; + outportb($3C9, c Shr 16); + outportb($3C9, c Shr 8); + outportb($3C9, c); + Inc(data); + End; +End; + +Procedure VGAConsole.check_open; + +Begin + {$IFDEF DEBUG} + If Not m_open Then + Raise TPTCError.Create('console is not open'); + {$ELSE} + {$ENDIF} +End; + +Procedure VGAConsole.check_unlocked; + +Begin + {$IFDEF DEBUG} + If m_locked Then + Raise TPTCError.Create('console is not unlocked'); + {$ELSE} + {$ENDIF} +End; diff --git a/packages/ptc/src/dos/fakemode/consoled.inc b/packages/ptc/src/dos/fakemode/consoled.inc new file mode 100644 index 0000000000..38e71dada2 --- /dev/null +++ b/packages/ptc/src/dos/fakemode/consoled.inc @@ -0,0 +1,119 @@ +Type + VGAConsole = Class(TPTCBaseConsole) + Private + { internal console management routines } + Procedure internal_pre_open_setup(Const _title : String); + Procedure internal_open_fullscreen_start; + Procedure internal_open_fullscreen(ModeType : Integer); + Procedure internal_open_fullscreen_finish(_pages : Integer); + Procedure internal_post_open_setup; + Procedure internal_reset; + Procedure internal_close; + Procedure internal_clear_mode_list; + Procedure internal_SetPalette(data : Pint32); + + Procedure vga_load(data : Pointer); + + { console debug checks } + Procedure check_open; + Procedure check_unlocked; + + { data } + m_modes : Array[0..31{255}] Of TPTCMode; +{ m_modes : PPTCMode;} +{ m_modes_last : Integer; + m_modes_n : PInteger;} + m_title : Array[0..1023] Of Char; + m_information : Array[0..1023] Of Char; + m_CurrentMode : Integer; +{ m_VESACurrentMode : Integer;} + m_faketype : Integer; + m_width, m_height, m_pitch, m_pages : Integer; + m_primary : Pointer; + + { flags } + m_open : Boolean; + m_locked : Boolean; + + { option data } + m_default_width : Integer; + m_default_height : Integer; + m_default_pages : Integer; + m_default_format : TPTCFormat; + + { objects } + m_copy : TPTCCopy; + m_area : TPTCArea; + m_clip : TPTCArea; + m_format : TPTCFormat; + + m_clear : TPTCClear; + m_palette : TPTCPalette; + + { Dos objects } + m_keyboard : TDosKeyboard; +{ m_primary : TPTCSurface;} +{ DosKeyboard *m_keyboard;} +{ m_160x100buffer : TPTCSurface;} + Protected + Procedure internal_ReadKey(k : TPTCKey); Override; + Function internal_PeekKey(k : TPTCKey) : Boolean; Override; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; Override; + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function width : Integer; Override; + Function height : Integer; Override; + Function pitch : Integer; Override; + Function pages : Integer; Override; + Function area : TPTCArea; Override; + Function clip : TPTCArea; Override; + Function format : TPTCFormat; Override; + Function name : String; Override; + Function title : String; Override; + Function information : String; Override; + End; diff --git a/packages/ptc/src/dos/fakemode/vga.pp b/packages/ptc/src/dos/fakemode/vga.pp new file mode 100644 index 0000000000..fc150bf17f --- /dev/null +++ b/packages/ptc/src/dos/fakemode/vga.pp @@ -0,0 +1,1401 @@ +{$MODE objfpc} +{$ASMMODE intel} + +Unit vga; + +Interface + +Const +{mode types} + FAKEMODE = 0; + RGB332 = 1; + INDEX8 = 2; +{fakemode types} + FAKEMODE1A = 0; + FAKEMODE1B = 1; + FAKEMODE1C = 2; + FAKEMODE2A = 3; + FAKEMODE2B = 4; + FAKEMODE2C = 5; + FAKEMODE3A = 6; + FAKEMODE3B = 7; + FAKEMODE3C = 8; + +Var + m_mode_type : Integer; + m_fake_type : Integer; + m_dispoffset : Integer; + +Procedure VGASetMode(xres, yres, modetype, faketype : Integer); +Procedure fakemode_load(src : PByte; wvr : Boolean); + +Implementation + +Uses + go32; + +Var + RealRegs : TRealRegs; + +Procedure vgamode; + +Begin + RealRegs.ax := $13; + realintr($10, RealRegs); +End; + +Procedure biostextmode; + +Begin + RealRegs.ax := 3; + realintr($10, RealRegs); +End; + +Procedure wait_retrace; + +Begin + While (inportb($3DA) And 8) <> 0 Do; + While (inportb($3DA) And 8) = 0 Do; +End; + +Procedure clearmem(d : DWord); Assembler; + +Asm + cld + push es + mov ax, fs + mov es, ax + mov edi, [d] + mov ecx, 2048/4 + mov eax, 0 + rep stosd + pop es +End; + +Procedure clear_memory; + +Var + dest : DWord; + strip : Integer; + +Begin + wait_retrace; + dest := $A0000; + For strip := 0 To 31 Do + Begin + outportw($3C4, $102); + clearmem(dest); + outportw($3C4, $202); + clearmem(dest); + outportw($3C4, $402); + clearmem(dest); + outportw($3C4, $802); + clearmem(dest); + Inc(dest, 2048); + End; +End; + +Procedure palette(data : PDWord); + +Var + I : Integer; + C : DWord; + +Begin + outportb($3C8, 0); + For I := 0 To 255 Do + Begin + C := (data[I] Shr 2) And $3F3F3F; + outportb($3C9, C Shr 16); + outportb($3C9, C Shr 8); + outportb($3C9, C); + End; +End; + +Procedure VGASetMode(xres, yres, modetype, faketype : Integer); + +Var + pal : Array[0..255] Of DWord; + I : Integer; + r, g, b : Integer; + z : Integer; + +Begin + m_mode_type := modetype; + { set up display offset to centre image on display } + m_dispoffset := ((100 - (yres Shr 1)) * 320) + (160 - (xres Shr 1)); + If (faketype < FAKEMODE1A) Or (faketype > FAKEMODE2C) Then + faketype := FAKEMODE2A; + m_fake_type := faketype; + + vgamode; + If modetype = FAKEMODE Then + Begin + FillChar(pal, SizeOf(pal), 0); + palette(@pal); + m_dispoffset := 0; + wait_retrace; + If (faketype >= FAKEMODE1A) And (faketype <= FAKEMODE1C) Then + Begin + {FAKEMODE1x - 320x600} + outportb($3D4, $11); + outportb($3D5, inportb($3D5) And $7F); + outportb($3C2, $E7); + outportb($3D4, $00); outportb($3D5, $5F); + outportb($3D4, $01); outportb($3D5, $4F); + outportb($3D4, $02); outportb($3D5, $50); + outportb($3D4, $03); outportb($3D5, $82); + outportb($3D4, $04); outportb($3D5, $54); + outportb($3D4, $05); outportb($3D5, $80); + outportb($3D4, $06); outportb($3D5, $70); + outportb($3D4, $07); outportb($3D5, $F0); + outportb($3D4, $08); outportb($3D5, $00); + outportb($3D4, $09); outportb($3D5, $60); + outportb($3D4, $10); outportb($3D5, $5B); + outportb($3D4, $11); outportb($3D5, $8C); + outportb($3D4, $12); outportb($3D5, $57); + outportb($3D4, $13); outportb($3D5, $28); + outportb($3D4, $14); outportb($3D5, $00); + outportb($3D4, $15); outportb($3D5, $58); + outportb($3D4, $16); outportb($3D5, $70); + outportb($3D4, $17); outportb($3D5, $E3); + outportb($3C4, $01); outportb($3C5, $01); + outportb($3C4, $04); outportb($3C5, $06); + outportb($3CE, $05); outportb($3CF, $40); + outportb($3CE, $06); outportb($3CF, $05); + outportb($3CE, $06); outportb($3CF, $05); + End + Else + Begin + outportb($3D4, $11); outportb($3D5, inportb($3D5) And $7F); + outportb($3C2, $63); + outportb($3D4, $00); outportb($3D5, $5F); + outportb($3D4, $01); outportb($3D5, $4F); + outportb($3D4, $02); outportb($3D5, $50); + outportb($3D4, $03); outportb($3D5, $82); + outportb($3D4, $04); outportb($3D5, $54); + outportb($3D4, $05); outportb($3D5, $80); + outportb($3D4, $06); outportb($3D5, $BF); + outportb($3D4, $07); outportb($3D5, $1F); + outportb($3D4, $08); outportb($3D5, $00); + outportb($3D4, $09); outportb($3D5, $40); + outportb($3D4, $10); outportb($3D5, $9C); + outportb($3D4, $11); outportb($3D5, $8E); + outportb($3D4, $12); outportb($3D5, $8F); + outportb($3D4, $13); outportb($3D5, $28); + outportb($3D4, $14); outportb($3D5, $00); + outportb($3D4, $15); outportb($3D5, $96); + outportb($3D4, $16); outportb($3D5, $B9); + outportb($3D4, $17); outportb($3D5, $E3); + outportb($3C4, $01); outportb($3C5, $01); + outportb($3C4, $04); outportb($3C5, $06); + outportb($3CE, $05); outportb($3CF, $40); + outportb($3CE, $06); outportb($3CF, $05); + outportb($3CE, $06); outportb($3CF, $05); + End; + clear_memory; + If (faketype >= FAKEMODE2A) And (faketype <= FAKEMODE2C) Then + Begin + {FAKEMODE2 palette} + {taken from PTC 0.73} + For I := 0 To $7F Do + Begin + {bit 7 = 0 (top section)} + {red (4 bits)} + r := Round(((I Shr 3) * 255) / 15); + {blue (3 bits)} + b := Round(((I And 7) * 255) / 7); + pal[I] := (r Shl 16) Or b; + End; + For I := $80 To $FF Do + Begin + {bit 7 = 1 (bottom section)} + {green} + g := Round(((I And $1F) * 255) / 31); + pal[I] := g Shl 8; + End; + End + Else + Begin + For I := 0 To 63 Do + Begin + {FAKEMODE(1,3) palette} + z := Round((I * 255) / 63); + pal[I] := z Shl 16; + pal[I + 64] := z Shl 8; + pal[I + 128] := z; + pal[I + 192] := (z Shl 16) Or (z Shl 8) Or z; + End; + End; + palette(@pal); + End + Else + If modetype = RGB332 Then + Begin + For I := 0 To 255 Do + Begin + r := Round(((I Shr 5) * 255) / 7); + g := Round((((I And $1C) Shr 2) * 255) / 7); + b := Round(((I And $03) * 255) / 3); + pal[I] := (r Shl 16) Or (g Shl 8) Or b; + End; + palette(@pal); + End; +End; + +Function PlaneBlt1_RGB(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := gl; + MemL[dest + 40*4] := b; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 40 * 4); + End; + PlaneBlt1_RGB := dest; +End; + +Function PlaneBlt1_RBG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := b; + MemL[dest + 40*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 40 * 4); + End; + PlaneBlt1_RBG := dest; +End; + +Function PlaneBlt1_GRB(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + MemL[dest + 40*4] := b; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 40 * 4); + End; + PlaneBlt1_GRB := dest; +End; + +Function PlaneBlt2_RBG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + b := gl; + gl := gl And $C0C0C0C0; + gl := gl Shr 6; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 2; + + b := b And $1C1C1C1C; + b := b Shr 2; + + r := r And $F0F0F0F0; + r := r Shr 1; + + Inc(r, b); + Inc(gl, gh); + gl := gl Or $80808080; + + MemL[dest] := r; + MemL[dest + 20*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 20 * 4); + End; + PlaneBlt2_RBG := dest; +End; + +Function PlaneBlt2_GBR(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + b := gl; + gl := gl And $C0C0C0C0; + gl := gl Shr 6; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 2; + + b := b And $1C1C1C1C; + b := b Shr 2; + + r := r And $F0F0F0F0; + r := r Shr 1; + + Inc(r, b); + Inc(gl, gh); + gl := gl Or $80808080; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 20 * 4); + End; + PlaneBlt2_GBR := dest; +End; + +Function PlaneBlt3_RGBRGB(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+(320*2)]) ) Or ((src[ 8+(320*2)]) Shl 8) Or + ((src[16+(320*2)]) Shl 16) Or ((src[24+(320*2)]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := gl; + MemL[dest + 40*4] := b; + + r := ((src[ 1+(320*2)]) ) Or ((src[ 9+(320*2)]) Shl 8) Or + ((src[17+(320*2)]) Shl 16) Or ((src[25+(320*2)]) Shl 24); + r := r And $F8F8F8F8; + r := r Shr 2; + + gl := ((src[ 0+(640*2)]) ) Or ((src[ 8+(640*2)]) Shl 8) Or + ((src[16+(640*2)]) Shl 16) Or ((src[24+(640*2)]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+(640*2)]) ) Or ((src[ 9+(640*2)]) Shl 8) Or + ((src[17+(640*2)]) Shl 16) Or ((src[25+(640*2)]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := r; + MemL[dest + 80*4] := gl; + MemL[dest + 100*4] := b; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 100 * 4); + Inc(src, 320 * 2 * 2); + End; + PlaneBlt3_RGBRGB := dest; +End; + +Function PlaneBlt3_GRBGRB(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+(320*2)]) ) Or ((src[ 8+(320*2)]) Shl 8) Or + ((src[16+(320*2)]) Shl 16) Or ((src[24+(320*2)]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + MemL[dest + 40*4] := b; + + r := ((src[ 1+(320*2)]) ) Or ((src[ 9+(320*2)]) Shl 8) Or + ((src[17+(320*2)]) Shl 16) Or ((src[25+(320*2)]) Shl 24); + r := r And $F8F8F8F8; + r := r Shr 2; + + gl := ((src[ 0+(640*2)]) ) Or ((src[ 8+(640*2)]) Shl 8) Or + ((src[16+(640*2)]) Shl 16) Or ((src[24+(640*2)]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+(640*2)]) ) Or ((src[ 9+(640*2)]) Shl 8) Or + ((src[17+(640*2)]) Shl 16) Or ((src[25+(640*2)]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := gl; + MemL[dest + 80*4] := r; + MemL[dest + 100*4] := b; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 100 * 4); + Inc(src, 320 * 2 * 2); + End; + PlaneBlt3_GRBGRB := dest; +End; + +Function PlaneBlt3_RBGRBG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+(320*2)]) ) Or ((src[ 8+(320*2)]) Shl 8) Or + ((src[16+(320*2)]) Shl 16) Or ((src[24+(320*2)]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := b; + MemL[dest + 40*4] := gl; + + r := ((src[ 1+(320*2)]) ) Or ((src[ 9+(320*2)]) Shl 8) Or + ((src[17+(320*2)]) Shl 16) Or ((src[25+(320*2)]) Shl 24); + r := r And $F8F8F8F8; + r := r Shr 2; + + gl := ((src[ 0+(640*2)]) ) Or ((src[ 8+(640*2)]) Shl 8) Or + ((src[16+(640*2)]) Shl 16) Or ((src[24+(640*2)]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+(640*2)]) ) Or ((src[ 9+(640*2)]) Shl 8) Or + ((src[17+(640*2)]) Shl 16) Or ((src[25+(640*2)]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := r; + MemL[dest + 80*4] := b; + MemL[dest + 100*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 100 * 4); + Inc(src, 320 * 2 * 2); + End; + PlaneBlt3_RBGRBG := dest; +End; + +Function PlaneBlt3_GRBRBG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+(320*2)]) ) Or ((src[ 8+(320*2)]) Shl 8) Or + ((src[16+(320*2)]) Shl 16) Or ((src[24+(320*2)]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + MemL[dest + 40*4] := b; + + r := ((src[ 1+(320*2)]) ) Or ((src[ 9+(320*2)]) Shl 8) Or + ((src[17+(320*2)]) Shl 16) Or ((src[25+(320*2)]) Shl 24); + r := r And $F8F8F8F8; + r := r Shr 2; + + gl := ((src[ 0+(640*2)]) ) Or ((src[ 8+(640*2)]) Shl 8) Or + ((src[16+(640*2)]) Shl 16) Or ((src[24+(640*2)]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+(640*2)]) ) Or ((src[ 9+(640*2)]) Shl 8) Or + ((src[17+(640*2)]) Shl 16) Or ((src[25+(640*2)]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := r; + MemL[dest + 80*4] := b; + MemL[dest + 100*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 100 * 4); + Inc(src, 320 * 2 * 2); + End; + PlaneBlt3_GRBRBG := dest; +End; + +Function PlaneBlt3_RBGGRB(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + row, col : Integer; + r, gl, gh, b : DWord; + +Begin + For row := 1 To rows Do + Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+(320*2)]) ) Or ((src[ 8+(320*2)]) Shl 8) Or + ((src[16+(320*2)]) Shl 16) Or ((src[24+(320*2)]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := b; + MemL[dest + 40*4] := gl; + + r := ((src[ 1+(320*2)]) ) Or ((src[ 9+(320*2)]) Shl 8) Or + ((src[17+(320*2)]) Shl 16) Or ((src[25+(320*2)]) Shl 24); + r := r And $F8F8F8F8; + r := r Shr 2; + + gl := ((src[ 0+(640*2)]) ) Or ((src[ 8+(640*2)]) Shl 8) Or + ((src[16+(640*2)]) Shl 16) Or ((src[24+(640*2)]) Shl 24); + b := gl; + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+(640*2)]) ) Or ((src[ 9+(640*2)]) Shl 8) Or + ((src[17+(640*2)]) Shl 16) Or ((src[25+(640*2)]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := gl; + MemL[dest + 80*4] := r; + MemL[dest + 100*4] := b; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + Inc(dest, 100 * 4); + Inc(src, 320 * 2 * 2); + End; + PlaneBlt3_RBGGRB := dest; +End; + +Function PlaneBlt3_RGBR(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + {row,} col : Integer; + r, gl, gh, b : DWord; + +Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+320*2]) ) Or ((src[ 8+320*2]) Shl 8) Or + ((src[16+320*2]) Shl 16) Or ((src[24+320*2]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := gl; + MemL[dest + 40*4] := b; + + r := ((src[ 1+320*2]) ) Or ((src[ 9+320*2]) Shl 8) Or + ((src[17+320*2]) Shl 16) Or ((src[25+320*2]) Shl 24); + r := r Or $F8F8F8F8; + r := r Shr 2; + + MemL[dest + 60*4] := r; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + PlaneBlt3_RGBR := dest; +End; + +Function PlaneBlt3_GRBG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + {row,} col : Integer; + r, gl, gh, b : DWord; + +Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+320*2]) ) Or ((src[ 8+320*2]) Shl 8) Or + ((src[16+320*2]) Shl 16) Or ((src[24+320*2]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + MemL[dest + 40*4] := b; + + gl := ((src[ 0+640*2]) ) Or ((src[ 8+640*2]) Shl 8) Or + ((src[16+640*2]) Shl 16) Or ((src[24+640*2]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+640*2]) ) Or ((src[ 9+640*2]) Shl 8) Or + ((src[17+640*2]) Shl 16) Or ((src[25+640*2]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + PlaneBlt3_GRBG := dest; +End; + +Function PlaneBlt3_RBGR(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + {row,} col : Integer; + r, gl, gh, b : DWord; + +Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+320*2]) ) Or ((src[ 8+320*2]) Shl 8) Or + ((src[16+320*2]) Shl 16) Or ((src[24+320*2]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := b; + MemL[dest + 40*4] := gl; + + r := ((src[ 1+320*2]) ) Or ((src[ 9+320*2]) Shl 8) Or + ((src[17+320*2]) Shl 16) Or ((src[25+320*2]) Shl 24); + r := r Or $F8F8F8F8; + r := r Shr 2; + + MemL[dest + 60*4] := r; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + PlaneBlt3_RBGR := dest; +End; + +Function PlaneBlt3_GRBR(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + {row,} col : Integer; + r, gl, gh, b : DWord; + +Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+320*2]) ) Or ((src[ 8+320*2]) Shl 8) Or + ((src[16+320*2]) Shl 16) Or ((src[24+320*2]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := gl; + MemL[dest + 20*4] := r; + MemL[dest + 40*4] := b; + + r := ((src[ 1+320*2]) ) Or ((src[ 9+320*2]) Shl 8) Or + ((src[17+320*2]) Shl 16) Or ((src[25+320*2]) Shl 24); + r := r Or $F8F8F8F8; + r := r Shr 2; + + MemL[dest + 60*4] := r; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + PlaneBlt3_GRBR := dest; +End; + +Function PlaneBlt3_RBGG(src : PByte; dest : DWord; rows : Integer) : DWord; + +Var + {row,} col : Integer; + r, gl, gh, b : DWord; + +Begin + For col := 0 To 19 Do + Begin + gl := ((src[ 0]) ) Or ((src[ 8]) Shl 8) Or + ((src[16]) Shl 16) Or ((src[24]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1]) ) Or ((src[ 9]) Shl 8) Or + ((src[17]) Shl 16) Or ((src[25]) Shl 24); + r := gh; + gh := gh And $07070707; + gh := gh Shl 3; + + b := ((src[ 0+320*2]) ) Or ((src[ 8+320*2]) Shl 8) Or + ((src[16+320*2]) Shl 16) Or ((src[24+320*2]) Shl 24); + b := b And $1F1F1F1F; + b := b Shl 1; + b := b Or $80808080; + + r := r And $F8F8F8F8; + r := r Shr 2; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest] := r; + MemL[dest + 20*4] := b; + MemL[dest + 40*4] := gl; + + gl := ((src[ 0+640*2]) ) Or ((src[ 8+640*2]) Shl 8) Or + ((src[16+640*2]) Shl 16) Or ((src[24+640*2]) Shl 24); + gl := gl And $E0E0E0E0; + gl := gl Shr 5; + + gh := ((src[ 1+640*2]) ) Or ((src[ 9+640*2]) Shl 8) Or + ((src[17+640*2]) Shl 16) Or ((src[25+640*2]) Shl 24); + gh := gh And $07070707; + gh := gh Shl 3; + + Inc(gl, gh); + gl := gl Or $40404040; + + MemL[dest + 60*4] := gl; + + Inc(dest, 4); + Inc(src, 4 * 4 * 2); + End; + PlaneBlt3_RBGG := dest; +End; + +Procedure fakemode_load(src : PByte; wvr : Boolean); + +Var + dest, d : DWord; + w, s : Integer; + +Begin + dest := $A0000; + Case m_fake_type Of + FAKEMODE1A : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt1_RGB(src + 0, dest, 8); + + {plane 1} + outportw($3C4, $202); + PlaneBlt1_RGB(src + 2, dest, 8); + + {plane 2} + outportw($3C4, $402); + PlaneBlt1_RGB(src + 4, dest, 8); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt1_RGB(src + 6, dest, 8); + Inc(src, 320 * 4 * 4); + End; + FAKEMODE1B : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + d := PlaneBlt1_RBG(src + (4*4*2*20*0), dest, 1); + d := PlaneBlt1_GRB(src + (4*4*2*20*1), d, 1); + d := PlaneBlt1_RBG(src + (4*4*2*20*2), d, 1); + d := PlaneBlt1_GRB(src + (4*4*2*20*3), d, 1); + d := PlaneBlt1_RBG(src + (4*4*2*20*4), d, 1); + d := PlaneBlt1_GRB(src + (4*4*2*20*5), d, 1); + d := PlaneBlt1_RBG(src + (4*4*2*20*6), d, 1); + d := PlaneBlt1_GRB(src + (4*4*2*20*7), d, 1); + + {plane 1} + outportw($3C4, $202); + d := PlaneBlt1_GRB(src + 2 + (4*4*2*20*0), dest, 1); + d := PlaneBlt1_RBG(src + 2 + (4*4*2*20*1), d, 1); + d := PlaneBlt1_GRB(src + 2 + (4*4*2*20*2), d, 1); + d := PlaneBlt1_RBG(src + 2 + (4*4*2*20*3), d, 1); + d := PlaneBlt1_GRB(src + 2 + (4*4*2*20*4), d, 1); + d := PlaneBlt1_RBG(src + 2 + (4*4*2*20*5), d, 1); + d := PlaneBlt1_GRB(src + 2 + (4*4*2*20*6), d, 1); + d := PlaneBlt1_RBG(src + 2 + (4*4*2*20*7), d, 1); + + {plane 2} + outportw($3C4, $402); + d := PlaneBlt1_RBG(src + 4 + (4*4*2*20*0), dest, 1); + d := PlaneBlt1_GRB(src + 4 + (4*4*2*20*1), d, 1); + d := PlaneBlt1_RBG(src + 4 + (4*4*2*20*2), d, 1); + d := PlaneBlt1_GRB(src + 4 + (4*4*2*20*3), d, 1); + d := PlaneBlt1_RBG(src + 4 + (4*4*2*20*4), d, 1); + d := PlaneBlt1_GRB(src + 4 + (4*4*2*20*5), d, 1); + d := PlaneBlt1_RBG(src + 4 + (4*4*2*20*6), d, 1); + d := PlaneBlt1_GRB(src + 4 + (4*4*2*20*7), d, 1); + + {plane 3} + outportw($3C4, $802); + d := PlaneBlt1_GRB(src + 6 + (4*4*2*20*0), dest, 1); + d := PlaneBlt1_RBG(src + 6 + (4*4*2*20*1), d, 1); + d := PlaneBlt1_GRB(src + 6 + (4*4*2*20*2), d, 1); + d := PlaneBlt1_RBG(src + 6 + (4*4*2*20*3), d, 1); + d := PlaneBlt1_GRB(src + 6 + (4*4*2*20*4), d, 1); + d := PlaneBlt1_RBG(src + 6 + (4*4*2*20*5), d, 1); + d := PlaneBlt1_GRB(src + 6 + (4*4*2*20*6), d, 1); + dest := PlaneBlt1_RBG(src + 6 + (4*4*2*20*7), d, 1); + Inc(src, 320*4*4); + End; + FAKEMODE1C : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt1_RBG(src + 0, dest, 8); + + {plane 1} + outportw($3C4, $202); + PlaneBlt1_GRB(src + 2, dest, 8); + + {plane 2} + outportw($3C4, $402); + PlaneBlt1_RBG(src + 4, dest, 8); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt1_GRB(src + 6, dest, 8); + Inc(src, 320 * 4 * 4); + End; + FAKEMODE2A : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt2_RBG(src + 0, dest, 8); + + {plane 1} + outportw($3C4, $202); + PlaneBlt2_RBG(src + 2, dest, 8); + + {plane 2} + outportw($3C4, $402); + PlaneBlt2_RBG(src + 4, dest, 8); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt2_RBG(src + 6, dest, 8); + Inc(src, 320 * 4 * 4); + End; + FAKEMODE2B : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + d := PlaneBlt2_RBG(src + (4*4*2*20*0), dest, 1); + d := PlaneBlt2_GBR(src + (4*4*2*20*1), d, 1); + d := PlaneBlt2_RBG(src + (4*4*2*20*2), d, 1); + d := PlaneBlt2_GBR(src + (4*4*2*20*3), d, 1); + d := PlaneBlt2_RBG(src + (4*4*2*20*4), d, 1); + d := PlaneBlt2_GBR(src + (4*4*2*20*5), d, 1); + d := PlaneBlt2_RBG(src + (4*4*2*20*6), d, 1); + d := PlaneBlt2_GBR(src + (4*4*2*20*7), d, 1); + + {plane 1} + outportw($3C4, $202); + d := PlaneBlt2_GBR(src + 2 + (4*4*2*20*0), dest, 1); + d := PlaneBlt2_RBG(src + 2 + (4*4*2*20*1), d, 1); + d := PlaneBlt2_GBR(src + 2 + (4*4*2*20*2), d, 1); + d := PlaneBlt2_RBG(src + 2 + (4*4*2*20*3), d, 1); + d := PlaneBlt2_GBR(src + 2 + (4*4*2*20*4), d, 1); + d := PlaneBlt2_RBG(src + 2 + (4*4*2*20*5), d, 1); + d := PlaneBlt2_GBR(src + 2 + (4*4*2*20*6), d, 1); + d := PlaneBlt2_RBG(src + 2 + (4*4*2*20*7), d, 1); + + {plane 2} + outportw($3C4, $402); + d := PlaneBlt2_RBG(src + 4 + (4*4*2*20*0), dest, 1); + d := PlaneBlt2_GBR(src + 4 + (4*4*2*20*1), d, 1); + d := PlaneBlt2_RBG(src + 4 + (4*4*2*20*2), d, 1); + d := PlaneBlt2_GBR(src + 4 + (4*4*2*20*3), d, 1); + d := PlaneBlt2_RBG(src + 4 + (4*4*2*20*4), d, 1); + d := PlaneBlt2_GBR(src + 4 + (4*4*2*20*5), d, 1); + d := PlaneBlt2_RBG(src + 4 + (4*4*2*20*6), d, 1); + d := PlaneBlt2_GBR(src + 4 + (4*4*2*20*7), d, 1); + + {plane 3} + outportw($3C4, $802); + d := PlaneBlt2_GBR(src + 6 + (4*4*2*20*0), dest, 1); + d := PlaneBlt2_RBG(src + 6 + (4*4*2*20*1), d, 1); + d := PlaneBlt2_GBR(src + 6 + (4*4*2*20*2), d, 1); + d := PlaneBlt2_RBG(src + 6 + (4*4*2*20*3), d, 1); + d := PlaneBlt2_GBR(src + 6 + (4*4*2*20*4), d, 1); + d := PlaneBlt2_RBG(src + 6 + (4*4*2*20*5), d, 1); + d := PlaneBlt2_GBR(src + 6 + (4*4*2*20*6), d, 1); + dest := PlaneBlt2_RBG(src + 6 + (4*4*2*20*7), d, 1); + Inc(src, 320*4*4); + End; + FAKEMODE2C : + For w := 0 To 24 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt2_RBG(src + 0, dest, 8); + + {plane 1} + outportw($3C4, $202); + PlaneBlt2_GBR(src + 2, dest, 8); + + {plane 2} + outportw($3C4, $402); + PlaneBlt2_RBG(src + 4, dest, 8); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt2_GBR(src + 6, dest, 8); + Inc(src, 320 * 4 * 4); + End; + FAKEMODE3A : Begin + For w := 0 To 15 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt3_RGBRGB(src + 0, dest, 4); + + {plane 1} + outportw($3C4, $202); + PlaneBlt3_RGBRGB(src + 2, dest, 4); + + {plane 2} + outportw($3C4, $402); + PlaneBlt3_RGBRGB(src + 4, dest, 4); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt3_RGBRGB(src + 6, dest, 4); + Inc(src, 320 * 4 * 2 * 3); + End; + s := (4*4*2*20) + (320*2*2*2); + outportw($3C4, $102); + d := PlaneBlt3_RGBRGB(src, dest, 2); + PlaneBlt3_RGBR(src + s, d, 1); + + outportw($3C4, $202); + d := PlaneBlt3_RGBRGB(src + 2, dest, 2); + PlaneBlt3_RGBR(src + s + 2, d, 1); + + outportw($3C4, $402); + d := PlaneBlt3_RGBRGB(src + 4, dest, 2); + PlaneBlt3_RGBR(src + s + 4, d, 1); + + outportw($3C4, $802); + d := PlaneBlt3_RGBRGB(src + 6, dest, 2); + PlaneBlt3_RGBR(src + s + 6, d, 1); + End; + FAKEMODE3B : Begin + For w := 0 To 15 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt3_GRBRBG(src + 0, dest, 4); + + {plane 1} + outportw($3C4, $202); + PlaneBlt3_RBGGRB(src + 2, dest, 4); + + {plane 2} + outportw($3C4, $402); + PlaneBlt3_GRBRBG(src + 4, dest, 4); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt3_RBGGRB(src + 6, dest, 4); + Inc(src, 320 * 4 * 2 * 3); + End; + s := (4*4*2*20) + (320*2*2*2); + outportw($3C4, $102); + d := PlaneBlt3_GRBRBG(src, dest, 2); + PlaneBlt3_GRBR(src + s, d, 1); + + outportw($3C4, $202); + d := PlaneBlt3_RBGGRB(src + 2, dest, 2); + PlaneBlt3_RBGG(src + s + 2, d, 1); + + outportw($3C4, $402); + d := PlaneBlt3_GRBRBG(src + 4, dest, 2); + PlaneBlt3_GRBR(src + s + 4, d, 1); + + outportw($3C4, $802); + d := PlaneBlt3_RBGGRB(src + 6, dest, 2); + PlaneBlt3_RBGG(src + s + 6, d, 1); + End; + FAKEMODE3C : Begin + For w := 0 To 15 Do + Begin + {plane 0} + outportw($3C4, $102); + PlaneBlt3_GRBGRB(src + 0, dest, 4); + + {plane 1} + outportw($3C4, $202); + PlaneBlt3_RBGRBG(src + 2, dest, 4); + + {plane 2} + outportw($3C4, $402); + PlaneBlt3_GRBGRB(src + 4, dest, 4); + + {plane 3} + outportw($3C4, $802); + dest := PlaneBlt3_RBGRBG(src + 6, dest, 4); + Inc(src, 320 * 4 * 2 * 3); + End; + s := (4*4*2*20) + (320*2*2*2); + outportw($3C4, $102); + d := PlaneBlt3_GRBGRB(src, dest, 2); + PlaneBlt3_GRBG(src + s, d, 1); + + outportw($3C4, $202); + d := PlaneBlt3_RBGRBG(src + 2, dest, 2); + PlaneBlt3_RBGR(src + s + 2, d, 1); + + outportw($3C4, $402); + d := PlaneBlt3_GRBGRB(src + 4, dest, 2); + PlaneBlt3_GRBG(src + s + 4, d, 1); + + outportw($3C4, $802); + d := PlaneBlt3_RBGRBG(src + 6, dest, 2); + PlaneBlt3_RBGR(src + s + 6, d, 1); + End; + End; + If wvr Then + wait_retrace; +End; + +End. diff --git a/packages/ptc/src/dos/textfx2/console.inc b/packages/ptc/src/dos/textfx2/console.inc new file mode 100644 index 0000000000..990b38cc4f --- /dev/null +++ b/packages/ptc/src/dos/textfx2/console.inc @@ -0,0 +1,650 @@ +{$MACRO ON} + +{$DEFINE DEFAULT_WIDTH:=320} +{$DEFINE DEFAULT_HEIGHT:=200} +{$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)} + +Constructor TextFX2Console.Create; + +Var + I : Integer; + +Begin + m_160x100buffer := Nil; + m_primary := Nil; + m_keyboard := Nil; + m_copy := Nil; + m_default_format := Nil; + m_open := False; + m_locked := False; + FillChar(m_modes, SizeOf(m_modes), 0); + m_title[0] := #0; + m_information[0] := #0; + m_default_width := DEFAULT_WIDTH; + m_default_height := DEFAULT_HEIGHT; + m_default_format := DEFAULT_FORMAT; + + + For I := Low(m_modes) To High(m_modes) Do + m_modes[I] := TPTCMode.Create; + + calcpal := @calcpal_colorbase; + use_charset := @charset_b7asc; + build_colormap(0); + m_copy := TPTCCopy.Create; + configure('ptc.cfg'); +End; + +Destructor TextFX2Console.Destroy; + +Var + I : Integer; + +Begin + close; + If m_160x100buffer <> Nil Then + m_160x100buffer.Destroy; + If m_primary <> Nil Then + m_primary.Destroy; + + For I := Low(m_modes) To High(m_modes) Do + If m_modes[I] <> Nil Then + m_modes[I].Destroy; + If m_keyboard <> Nil Then + m_keyboard.Destroy; + If m_copy <> Nil Then + m_copy.Destroy; + If m_default_format <> Nil Then + m_default_format.Destroy; + dispose_colormap; + Inherited Destroy; +End; + +Procedure TextFX2Console.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + ASSign(F, _file); + Try + Reset(F); + Except + Exit; + End; + Try + While Not EoF(F) Do + Begin + Readln(F, S); + option(S); + End; + Finally + CloseFile(F); + End; +End; + +Function TextFX2Console.option(Const _option : String) : Boolean; + +Begin + {...} + option := True; + If _option = 'charset_b8ibm' Then + Begin + use_charset := @charset_b8ibm; + Exit; + End; + If _option = 'charset_b7asc' Then + Begin + use_charset := @charset_b7asc; + Exit; + End; + If _option = 'charset_b7sml' Then + Begin + use_charset := @charset_b7sml; + Exit; + End; + If _option = 'charset_b8gry' Then + Begin + use_charset := @charset_b8gry; + Exit; + End; + If _option = 'charset_b7nws' Then + Begin + use_charset := @charset_b7nws; + Exit; + End; + If _option = 'calcpal_colorbase' Then + Begin + calcpal := @calcpal_colorbase; + build_colormap(0); + Exit; + End; + If _option = 'calcpal_lightbase' Then + Begin + calcpal := @calcpal_lightbase; + build_colormap(0); + Exit; + End; + If _option = 'calcpal_lightbase_g' Then + Begin + calcpal := @calcpal_lightbase_g; + build_colormap(0); + Exit; + End; + option := m_copy.option(_option); +End; + +Function TextFX2Console.modes : PPTCMode; + +Begin + {todo...} + modes := @m_modes; +End; + +Procedure TextFX2Console.open(Const _title : String; _pages : Integer); Overload; + +Begin + open(_title, m_default_format, _pages); +End; + +Procedure TextFX2Console.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; + +Begin + open(_title, m_default_width, m_default_height, _format, _pages); +End; + +Procedure TextFX2Console.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; + +Var + m : TPTCMode; + +Begin + m := TPTCMode.Create(_width, _height, _format); + open(_title, m, _pages); + m.Destroy; +End; + +Procedure TextFX2Console.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; + +Var + _width, _height : Integer; + _format : TPTCFormat; + +Begin + If Not _mode.valid Then + Raise TPTCError.Create('invalid mode'); + _width := _mode.width; + _height := _mode.height; + _format := _mode.format; + internal_pre_open_setup(_title); + internal_open_fullscreen_start; + internal_open_fullscreen(_width, _height, _format); + internal_open_fullscreen_finish(_pages); + internal_post_open_setup; +End; + +Procedure TextFX2Console.close; + +Begin + If m_open Then + Begin + If m_locked Then + Raise TPTCError.Create('console is still locked'); + {flush all key presses} + While KeyPressed Do ReadKey; + internal_close; + m_open := False; + End; +End; + +Procedure TextFX2Console.flush; + +Begin + check_open; + check_unlocked; +End; + +Procedure TextFX2Console.finish; + +Begin + check_open; + check_unlocked; +End; + +Procedure TextFX2Console.update; + +Var + framebuffer : PInteger; + +Begin + check_open; + check_unlocked; +{ m_primary.clear;} + m_primary.copy(m_160x100buffer); + framebuffer := m_160x100buffer.lock; + vrc; + dump_160x(0, 50, framebuffer); + m_160x100buffer.unlock; +End; + +Procedure TextFX2Console.update(Const _area : TPTCArea); + +Begin + update; +End; + +Procedure TextFX2Console.internal_ReadKey(k : TPTCKey); + +Begin + check_open; + m_keyboard.internal_ReadKey(k); +End; + +Function TextFX2Console.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + check_open; + Result := m_keyboard.internal_PeekKey(k); +End; + +Procedure TextFX2Console.copy(Var surface : TPTCBaseSurface); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Procedure TextFX2Console.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Begin +End; + +Function TextFX2Console.lock : Pointer; + +Var + pixels : Pointer; + +Begin + check_open; + If m_locked Then + Raise TPTCError.Create('console is already locked'); + pixels := m_primary.lock; + m_locked := True; + lock := pixels; +End; + +Procedure TextFX2Console.unlock; + +Begin + check_open; + If Not m_locked Then + Raise TPTCError.Create('console is not locked'); + m_primary.unlock; + m_locked := False; +End; + +Procedure TextFX2Console.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + c, a : TPTCArea; + +Begin + c := clip; a := area; + If (c.left = a.left) And + (c.top = a.top) And + (c.right = a.right) And + (c.bottom = a.bottom) Then + Begin + check_open; + check_unlocked; + console_pixels := lock; + Try + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0, + width, height, pitch); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + load(pixels, _width, _height, _pitch, _format, _palette, Area_, area); + Area_.Destroy; + End; +End; + +Procedure TextFX2Console.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + console_pixels := lock; + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination); + tmp.Destroy; + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch); + unlock; + Except + On error:TPTCError Do + Begin + clipped_source.Destroy; + clipped_destination.Destroy; + unlock; + Raise TPTCError.Create('failed to load pixels to console area', error); + End; + End; + clipped_source.Destroy; + clipped_destination.Destroy; +End; + +Procedure TextFX2Console.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + c, a : TPTCArea; + +Begin + c := clip; a := area; + If (c.left = a.left) And + (c.top = a.top) And + (c.right = a.right) And + (c.bottom = a.bottom) Then + Begin + check_open; + check_unlocked; + console_pixels := lock; + Try + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0, + _width, _height, _pitch); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to save console pixels', error); + End; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + save(pixels, _width, _height, _pitch, _format, _palette, area, Area_); + Area_.Destroy; + End; +End; + +Procedure TextFX2Console.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + console_pixels := lock; + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination); + tmp.Destroy; + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch, + pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch); + unlock; + Except + On error:TPTCError Do + Begin + clipped_source.Destroy; + clipped_destination.Destroy; + unlock; + Raise TPTCError.Create('failed to save console area pixels', error); + End; + End; + clipped_source.Destroy; + clipped_destination.Destroy; +End; + +Procedure TextFX2Console.clear; + +Begin +End; + +Procedure TextFX2Console.clear(Const color : TPTCColor); + +Begin +End; + +Procedure TextFX2Console.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin +End; + +Procedure TextFX2Console.palette(Const _palette : TPTCPalette); + +Begin + check_open; + m_primary.palette(_palette); +End; + +Function TextFX2Console.palette : TPTCPalette; + +Begin + check_open; + palette := m_primary.palette; +End; + +Procedure TextFX2Console.clip(Const _area : TPTCArea); + +Begin + check_open; + m_primary.clip(_area); +End; + +Function TextFX2Console.width : Integer; + +Begin + check_open; + width := m_primary.width; +End; + +Function TextFX2Console.height : Integer; + +Begin + check_open; + height := m_primary.height; +End; + +Function TextFX2Console.pitch : Integer; + +Begin + check_open; + pitch := m_primary.pitch; +End; + +Function TextFX2Console.pages : Integer; + +Begin + check_open; + pages := 2;{m_primary.pages;} +End; + +Function TextFX2Console.area : TPTCArea; + +Begin + check_open; + area := m_primary.area; +End; + +Function TextFX2Console.clip : TPTCArea; + +Begin + check_open; + clip := m_primary.clip; +End; + +Function TextFX2Console.format : TPTCFormat; + +Begin + check_open; + format := m_primary.format; +End; + +Function TextFX2Console.name : String; + +Begin +End; + +Function TextFX2Console.title : String; + +Begin +End; + +Function TextFX2Console.information : String; + +Begin +End; + +Procedure TextFX2Console.internal_pre_open_setup(Const _title : String); + +Begin + +End; + +Procedure TextFX2Console.internal_open_fullscreen_start; + +Var + f : TPTCFormat; + +Begin + f := TPTCFormat.Create(32, $0000FF, $00FF00, $FF0000); + m_160x100buffer := TPTCSurface.Create(160, 100, f); + f.Destroy; + set80x50; +End; + +Procedure TextFX2Console.internal_open_fullscreen(_width, _height : Integer; Const _format : TPTCFormat); + +Begin + m_primary := TPTCSurface.Create(_width, _height, _format); +End; + +Procedure TextFX2Console.internal_open_fullscreen_finish(_pages : Integer); + +Begin +End; + +Procedure TextFX2Console.internal_post_open_setup; + +Begin + If m_keyboard <> Nil Then + m_keyboard.Destroy; + m_keyboard := TDosKeyboard.Create; + { create win32 keyboard + m_keyboard = new DosKeyboard();//m_window->handle(),m_window->thread(),false);} + + { temporary platform dependent information fudge } + {sprintf(m_information,"dos version x.xx.x\nvesa version x.xx\nvesa driver name xxxxx\ndisplay driver vendor xxxxx\ncertified driver? x\n");} + + { set open flag } + m_open := True; +End; + +Procedure TextFX2Console.internal_reset; + +Begin + If m_primary <> Nil Then + m_primary.Destroy; +{ m_keyboard.Destroy;} + m_primary := Nil; +{ m_keyboard := Nil;} +End; + +Procedure TextFX2Console.internal_close; + +Begin + If m_primary <> Nil Then + m_primary.Destroy; + m_primary := Nil; + If m_160x100buffer <> Nil Then + m_160x100buffer.Destroy; + m_160x100buffer := Nil; + set80x25; +{ m_keyboard.Destroy; + m_keyboard := Nil;} +End; + +Procedure TextFX2Console.check_open; + +Begin + {$IFDEF DEBUG} + If Not m_open Then + Raise TPTCError.Create('console is not open'); + {$ENDIF} +End; + +Procedure TextFX2Console.check_unlocked; + +Begin + {$IFDEF DEBUG} + If m_locked Then + Raise TPTCError.Create('console is not unlocked'); + {$ENDIF} +End; diff --git a/packages/ptc/src/dos/textfx2/consoled.inc b/packages/ptc/src/dos/textfx2/consoled.inc new file mode 100644 index 0000000000..b909de8055 --- /dev/null +++ b/packages/ptc/src/dos/textfx2/consoled.inc @@ -0,0 +1,101 @@ +Type + TextFX2Console = Class(TPTCBaseConsole) + Private + { internal console management routines } + Procedure internal_pre_open_setup(Const _title : String); + Procedure internal_open_fullscreen_start; + Procedure internal_open_fullscreen(_width, _height : Integer; Const _format : TPTCFormat); + Procedure internal_open_fullscreen_finish(_pages : Integer); + Procedure internal_post_open_setup; + Procedure internal_reset; + Procedure internal_close; + + { console debug checks } + Procedure check_open; + Procedure check_unlocked; + + { data } + m_modes : Array[0..255] Of TPTCMode; + m_title : Array[0..1023] Of Char; + m_information : Array[0..1023] Of Char; + + { flags } + m_open : Boolean; + m_locked : Boolean; + + { option data } + m_default_width : Integer; + m_default_height : Integer; + m_default_pages : Integer; + m_default_format : TPTCFormat; + + { objects } + m_copy : TPTCCopy; + + { Dos objects } + m_keyboard : TDosKeyboard; + m_primary : TPTCSurface; +{ DosKeyboard *m_keyboard;} + m_160x100buffer : TPTCSurface; + Protected + Procedure internal_ReadKey(k : TPTCKey); Override; + Function internal_PeekKey(k : TPTCKey) : Boolean; Override; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; Override; + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function width : Integer; Override; + Function height : Integer; Override; + Function pitch : Integer; Override; + Function pages : Integer; Override; + Function area : TPTCArea; Override; + Function clip : TPTCArea; Override; + Function format : TPTCFormat; Override; + Function name : String; Override; + Function title : String; Override; + Function information : String; Override; + End; diff --git a/packages/ptc/src/dos/textfx2/textfx2.pp b/packages/ptc/src/dos/textfx2/textfx2.pp new file mode 100644 index 0000000000..4149160adb --- /dev/null +++ b/packages/ptc/src/dos/textfx2/textfx2.pp @@ -0,0 +1,564 @@ +{* + * TextFX2 Copyright (c) 1998 Jari Komppa aka Sol/Trauma + * <mailto:solar@compart.fi> + * + * Textmode low-level functions + * + * This sourcefile is kinda long-ish, and should be split into several + * sources, but I have wanted to keep it in one file since everything + * here is kinda small and.. well, I wanted to keep it as a single .obj + * file. + * + * If you make improvements, send me a copy! + * If you use this for something, let me know! + *} + +{$MODE objfpc} + +Unit textfx2; + +Interface + +Const +{* + * Charsets in 'lightness' order. First byte = num of chars + * + * Please note that these don't work with the current calcpal + * strategy :) + * + *} + charset_b8ibm : Array[0..254] Of Byte = { all imbscii characters } +( 254, 32, 96, 39, 250, 95, 126, 46, 94, 34, 249, 248, 44, 58, 45, +196, 59, 253, 167, 61, 166, 252, 47, 28, 217, 192, 169, 205, 246, 7, +170, 27, 190, 43, 212, 62, 60, 124, 26, 226, 193, 40, 243, 242, 240, +63, 41, 37, 139, 191, 55, 91, 207, 218, 200, 176, 9, 105, 241, 92, +141, 33, 125, 238, 102, 161, 231, 123, 211, 202, 247, 108, 99, 168, +188, 73, 93, 67, 29, 175, 174, 106, 114, 189, 140, 24, 76, 116, 194, +208, 49, 115, 50, 70, 228, 13, 84, 80, 156, 51, 120, 122, 179, 173, +184, 53, 89, 155, 244, 213, 90, 25, 135, 223, 57, 42, 83, 118, 128, +101, 245, 127, 171, 74, 19, 159, 4, 1, 180, 110, 137, 230, 195, 209, +18, 97, 111, 117, 86, 229, 31, 138, 69, 144, 22, 148, 130, 16, 132, +181, 129, 36, 157, 198, 136, 12, 214, 71, 239, 133, 160, 162, 149, +163, 151, 52, 54, 98, 107, 251, 104, 224, 197, 183, 154, 235, 164, +112, 131, 85, 147, 121, 236, 150, 232, 134, 153, 11, 210, 225, 79, +172, 145, 227, 152, 100, 23, 21, 88, 17, 48, 119, 75, 68, 113, 30, 72, +15, 233, 56, 103, 65, 142, 234, 5, 82, 109, 216, 201, 254, 66, 38, +158, 143, 237, 203, 187, 77, 221, 146, 14, 78, 35, 81, 64, 20, 177, +87, 6, 165, 3, 204, 186, 222, 199, 206, 185, 182, 215, 220, 2, 178, +10, 8, 219); + + charset_b7asc : Array[0..94] Of Byte = { 7b ascii (chars 32 - 126) } +( 94, 32, 96, 39, 95, 126, 46, 94, 34, 44, 58, 45, 59, 61, 47, 43, 62, +60, 40, 63, 41, 37, 55, 91, 105, 92, 33, 125, 102, 123, 108, 99, 73, +93, 67, 106, 114, 76, 116, 49, 115, 50, 70, 84, 80, 51, 120, 122, 53, +89, 90, 57, 42, 83, 118, 101, 74, 110, 97, 111, 117, 86, 69, 36, 71, +52, 54, 98, 107, 104, 112, 85, 121, 79, 100, 88, 48, 119, 75, 68, 113, +72, 56, 103, 65, 82, 109, 66, 38, 77, 78, 35, 81, 64, 87); + + charset_b7sml : Array[0..14] Of Byte = { " crsxzvenaouwm" dark->light. } +( 14, 32, 99, 114, 115, 120, 122, 118, 101, 110, 97, 111, 117, 119, +109 ); + + charset_b8gry : Array[0..5] Of Byte = { 8b ibm grayscale characters } +( 5, 32, 176, 177, 178, 219 ); + + charset_b7nws : Array[0..6] Of Byte = { 7b grayscale 'newschool' askee chars} +( 6, 32{' '}, 46{'.'}, 111{'o'}, 109{'m'}, 87{'W'}, 77{'M'} ); + + use_charset : Pbyte = @charset_b7asc; + { Character set to use. Can be changed run-time. } + + colmap : PSmallInt = Nil; + +Procedure set80x43; { Sets up 80x43, no blink, no cursor. } +Procedure set80x50; { Sets up 80x50, no blink, no cursor. } +Procedure set80x25; { Resets 80x25, blink, cursor. } +Procedure border(color : Byte); { _ONLY_ for debugging! } +Procedure vrc; { Although all should be timer-synced instead.. } + +{* + * calc_ functions are pretty *S*L*O*W* so use them to precalculate + * color tables and then use those tables instead. + *} + +Function calcpal_colorbase(red, green, blue : Real) : Word; +Function calcpal_lightbase(red, green, blue : Real) : Word; +Function calcpal_lightbase_g(red, green, blue : Real) : Word; +{Function (*calcpal)(float red, float green, float blue) : Word;} +Const calcpal : Function(red, green, blue : Real) : Word = @calcpal_colorbase; + {* Finds the closest color/char combo for any 0:63,0:63,0:63 value. + * + * calcpal_colorbase is the 'old' calcpal, only "a bit" optimized. + * calcpal is now function pointer so calcpal function can be changed + * run-time. Use the functions directly if you need speed (and + * compile with -oe256 or something to force inlining) + *} + +Function calc_gscale(light : Real) : Word; +Function calc_gscale2(light : Real) : Word; + {* Finds the closes gscale color/char combo for 0..1 range + * gscale2 uses colors 8,7,15, normal just uses 7. + *} + +Procedure build_colormap(dots : Integer); + {* Used to calculate colormap for dump_nnx() -functions. + * if dots=0, will output nothing. + * 1, will cprintf .:s as process. + * 2, will cprintf rolling wheel as process. + *} + +Procedure dispose_colormap; + +Procedure dump_80x(y0, y1 : Integer; buffer : PInteger); + {* Dumps 80-pixel wide 0bgr-truecolor buffer from y0 to y1. + * (For fullscreen dump in 80x43 use dump_80x(0,43,buf); + *} + +Procedure dump_160x(y0, y1 : Integer; buffer : PInteger); + {* Dumps 160-pixel wide 0bgr-truecolor buffer from y0 to y1 + * with 4-to-1 pixel averaging. + *} + +Procedure dump_320x(y0, y1 : Integer; buffer : PInteger); + {* Dumps 160-pixel wide 0bgr-truecolor buffer from y0 to y1 + * with 16-to-1 pixel averaging. (this is tad bit slow :) + *} + +Implementation + +Uses + go32; + +{ $define __USE_178NOT176} + { uncomment to use 75% char instead of 25% char } + +{$DEFINE __USE_REALIBMPAL} + { comment out to use 'clean' truecolor palette for calculations } + +Const + COLORMAP_DEPTH = 4; + {* Normally, build 1<<4, ie. 16x16x16 colormap. + * If you require bigger map, increase the value. + * (5 will mean 32x32x32 etc). + * 8 is max for dump_80x and _320x, 6 is max for _160x. + * If you make your own routines, well, nothing is too much :) + *} +{ Don't touch the rest of the defines. } + COLMAPDIM = 1 Shl COLORMAP_DEPTH; + TRUCOLBITS = 8 - COLORMAP_DEPTH; + +{$IFDEF __USE_REALIBMPAL} + palette : Array[0..16*3-1] Of Byte = ( {IBM basic palette, 16c} + 0, 0, 0, 0, 0,42, 0,42, 0, 0,42,42, 42, 0, 0, 42, 0,42, 42,21, 0, 42,42,42, + 21,21,21, 21,21,63, 21,63,21, 21,63,63, 63,21,21, 63,21,63, 63,63,21, 63,63,63); +{$ELSE} + palette : Array[0..16*3-1] Of Byte = ( { 'clean' RGB palette } + 0, 0, 0, 0, 0,32, 0,32, 0, 0,32,32, 32, 0, 0, 32, 0,32, 32,32, 0, 32,32,32, + 32,32,32, 0, 0,63, 0,63, 0, 0,63,63, 63, 0, 0, 63, 0,63, 63,63, 0, 63,63,63); +{$ENDIF} + +Procedure set80x43; { Sets up 80x43, no blink, no cursor. } + +Var + regs : TRealRegs; + +Begin + regs.ax := $1201; { Set 350 scanlines } + regs.bl := $30; + realintr($10, regs); + regs.ax := $3; { Set text mode } + realintr($10, regs); + regs.ax := $1112; { Set font } + regs.bx := 0; + realintr($10, regs); + regs.bh := 0; { Kill cursor - doesn't seem to work.. } + regs.ah := 3; + realintr($10, regs); + regs.cx := $2000; + regs.ah := 1; + realintr($10, regs); + regs.ax := $1003; { Kill blink } + regs.bl := 0; + realintr($10, regs); + regs.ax := $0200; { Position cursor to 51,80 - better way to kill. } + regs.bx := $0033; + regs.dx := $004f; + realintr($10, regs); +End; + +Procedure set80x50; { Sets up 80x50, no blink, no cursor. } + +Var + regs : TRealRegs; + +Begin + regs.ax := $1202; { Set 400 scanlines } + regs.bl := $30; + realintr($10, regs); + regs.ax := $3; { Set text mode } + realintr($10, regs); + regs.ax := $1112; { Set font } + regs.bx := 0; + realintr($10, regs); + regs.bh := 0; { Kill cursor - doesn't seem to work.. } + regs.ah := 3; + realintr($10, regs); + regs.cx := $2000; + regs.ah := 1; + realintr($10, regs); + regs.ax := $1003; { Kill blink } + regs.bl := 0; + realintr($10, regs); + regs.ax := $0200; { Position cursor to 51,80 - better way to kill. } + regs.bx := $0033; + regs.dx := $004f; + realintr($10, regs); +End; + +Procedure set80x25; { Resets 80x25, blink, cursor. } + +Var + regs : TRealRegs; + +Begin + regs.ax := $1202; { Set 400 scanlines } + regs.bl := $30; + realintr($10, regs); + regs.ax := $3; { Set text mode } + realintr($10, regs); + regs.ax := $1114; { Set font } + regs.bx := 0; + realintr($10, regs); + regs.bh := 0; { Ressurrect cursor } + regs.ah := 3; + realintr($10, regs); + regs.cx := regs.cx And $dfff; + regs.ah := 1; + realintr($10, regs); + regs.ax := $1003; { Enable blink } + regs.bl := 1; + realintr($10, regs); +End; + +Procedure border(color : Byte); { _ONLY_ for debugging! } + +Begin + inportb($3da); + outportb($3c0, 17+32); + outportb($3c0, color); +End; + +Procedure vrc; { Although all should be timer-synced instead.. } + +Begin + While (inportb($3da) And 8) = 0 Do ; + While (inportb($3da) And 8) <> 0 Do ; +End; + +{#define COLMAP(r,g,b) *(colmap+((r)<<(COLORMAP_DEPTH*2))+((g)<<COLORMAP_DEPTH)+(b))} +Function COLMAP_(r, g, b : Integer) : Integer;{ Inline;} + +Begin + COLMAP_ := (colmap + ((r Shl (COLORMAP_DEPTH*2)) + (g Shl COLORMAP_DEPTH) + b))^; +End; + +Procedure COLMAPSet(r, g, b, v : Integer);{ Inline;} + +Begin + (colmap + ((r Shl (COLORMAP_DEPTH*2)) + (g Shl COLORMAP_DEPTH) + b))^ := v; +End; + +Function calcpal_colorbase(red, green, blue : Real) : Word; + +Var + a, b, c, d, ch, co : Integer; + lastdist, dist : Double; + +Begin + red := red * 1.2; + green := green * 1.2; + blue := blue * 1.2; + lastdist := 1e242; + d := 0; + For c := 0 To 15 Do + Begin + dist := sqr(palette[d + 0] - red) + + sqr(palette[d + 1] - green) + + sqr(palette[d + 2] - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := c; + ch := 219; { 100% block in IBMSCII } + End; + Inc(d, 3); + End; + c := co; + d := c*3; + a := 0; + For b := 0 To 15 Do + Begin + dist := sqr(((palette[a+0]+palette[d+0]) / 2.0) - red) + + sqr(((palette[a+1]+palette[d+1]) / 2.0) - green) + + sqr(((palette[a+2]+palette[d+2]) / 2.0) - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := b + (c Shl 4); + ch := 177; { 50% block in IBMSCII } + End; + {$IFDEF __USE_178NOT176} + dist := sqr((palette[a+0]*0.75+palette[d+0]*0.25) - red) + + sqr((palette[a+1]*0.75+palette[d+1]*0.25) - green) + + sqr((palette[a+2]*0.75+palette[d+2]*0.25) - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := b + (c Shl 4); + ch := 178; { 75% block in IBMSCII } + End; + dist := sqr((palette[a+0]*0.25+palette[d+0]*0.75) - red) + + sqr((palette[a+1]*0.25+palette[d+1]*0.75) - green) + + sqr((palette[a+2]*0.25+palette[d+2]*0.75) - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := c + (b Shl 4); + ch := 178; { 75% block in IBMSCII } + End; + {$ELSE} + dist := sqr((palette[a+0]*0.25+palette[d+0]*0.75) - red) + + sqr((palette[a+1]*0.25+palette[d+1]*0.75) - green) + + sqr((palette[a+2]*0.25+palette[d+2]*0.75) - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := b + (c Shl 4); + ch := 176; { 25% block in IBMSCII } + End; + dist := sqr((palette[a+0]*0.75+palette[d+0]*0.25) - red) + + sqr((palette[a+1]*0.75+palette[d+1]*0.25) - green) + + sqr((palette[a+2]*0.75+palette[d+2]*0.25) - blue); + If dist < lastdist Then + Begin + lastdist := dist; + co := c + (b Shl 4); + ch := 176; { 25% block in IBMSCII } + End; + {$ENDIF} + Inc(a, 3); + End; + calcpal_colorbase := (co Shl 8) + ch; +End; + +{* + * Unlike _colorbase, _lightbase and _gscale calculations are + * based on some trivial assumptions, such as that the character + * tables have linear grayscale ramps and stuff like that. + * + * ie: they are *not* accurate! + * + * The tables were generated by calculating the dot distance from + * center of character, ((xdistmax-xdist)^2)+((ydistmax-ydist)^2), + * and sorting by this value. (HOW are you supposed to calculate + * random pattern lightness value anyway?! =) + * + * Bright and dark color values are just thrown in without any + * math background. (How could there be some? At this point you + * should realize we have thrown all accurancy out the window). + * + * So. They work - kinda. They don't work correctly, but there + * you go. + * + * color ramp= (dark color) [0 .. 1] + (light color) [0.3 .. 1] + * + * (didn't bother to rip AAlib :) + *} + +Function calcpal_lightbase(red, green, blue : Real) : Word; + +Var + light, col, a, a3 : Integer; + lastdist, dist : Real; + +Begin + lastdist := 1e24; + a3 := 3; + For a := 1 To 15 Do + Begin + dist := Sqr(palette[a * 3 + 0] - red) + + Sqr(palette[a * 3 + 1] - green) + + Sqr(palette[a * 3 + 2] - blue); + If dist < lastdist Then + Begin + lastdist := dist; + col := a; + End; + Inc(a3, 3); + End; + light := Trunc(((0.2990 * red + 0.5870 * green + 0.1140 * blue) / 63) * 64); + If light < 32 Then + light := Trunc(((0.2990 * red + 0.5870 * green + 0.1140 * blue) / 63) * 1.5 * use_charset^) + Else + light := Trunc(((0.2990 * red + 0.5870 * green + 0.1140 * blue) / 63) * use_charset^); + calcpal_lightbase := (col Shl 8) + (use_charset + light + 1)^; +End; + +Function calcpal_lightbase_g(red, green, blue : Real) : Word; + +Var + light : Integer; + +Begin + light := Trunc(((0.2990 * red + 0.5870 * green + 0.1140 * blue) / 63) * use_charset^); + calcpal_lightbase_g := (7 Shl 8) + (use_charset + light + 1)^; +End; + +Function calc_gscale(light : Real) : Word; + +Begin + calc_gscale := (7 Shl 8) + (use_charset + Trunc(light * (use_charset^ + 1)))^; +End; + +Function calc_gscale2(light : Real) : Word; + +Begin + If light < 0.3 Then + calc_gscale2 := (8 Shl 8) + (use_charset + Trunc(light * 3 * (use_charset^ + 1)))^ + Else + If light < 0.6 Then + calc_gscale2 := (7 Shl 8) + (use_charset + Trunc((light + 0.3) * (use_charset^ + 1)))^ + Else + calc_gscale2 := (15 Shl 8) + (use_charset + Trunc(light * (use_charset^ + 1)))^; +End; + +Procedure build_colormap(dots : Integer); + +Const + wheel : Array[0..3] Of Char = ('-', '\', '|', '/'); + +Var + r, g, b : Integer; + f : Double; + +Begin + If dots = 2 Then + Write(' '); + If colmap <> Nil Then + FreeMem(colmap); + f := 64.0 / COLMAPDIM; + colmap := GetMem(SizeOf(SmallInt) * COLMAPDIM * COLMAPDIM * COLMAPDIM); + For r := 0 To COLMAPDIM - 1 Do + Begin + For g := 0 To COLMAPDIM - 1 Do + For b := 0 To COLMAPDIM - 1 Do + COLMAPSet(r, g, b, calcpal(r * f, g * f, b * f)); + If dots = 1 Then + Write('.'); + If dots = 2 Then + Write({#127}#8, wheel[r And 3]); + End; +End; + +Procedure dispose_colormap; + +Begin + If colmap <> Nil Then + FreeMem(colmap); + colmap := Nil; +End; + +Procedure dump_80x(y0, y1 : Integer; buffer : PInteger); + +Var + x, y, yd : Integer; + scr : DWord; + buf : PByte; + +Begin + buf := PByte(buffer); + scr := $b8000 + (y0 * 160); + yd := y1 - y0; + For y := 0 To yd - 1 Do + For x := 0 To 79 Do + Begin + MemW[scr] := COLMAP_((buf + 0)^ Shr TRUCOLBITS, + (buf + 1)^ Shr TRUCOLBITS, + (buf + 2)^ Shr TRUCOLBITS); + Inc(scr, 2); + Inc(buf, 4); + End; +End; + +Procedure dump_160x(y0, y1 : Integer; buffer : PInteger); + +Var + x, y, yd : Integer; + i : DWord; + scr : DWord; + buf : PByte; + +Begin + buf := @i; + scr := $b8000 + (y0 * 160); + yd := y1 - y0; + For y := 0 To yd - 1 Do + Begin + For x := 0 To 79 Do + Begin + i := ((buffer+0)^ And $fcfcfcfc)+ + ((buffer+1)^ And $fcfcfcfc)+ + ((buffer+160)^ And $fcfcfcfc)+ + ((buffer+161)^ And $fcfcfcfc); + i := i Shr 2; + i := i And $fcfcfcfc; + MemW[scr] := COLMAP_((buf + 0)^ Shr TRUCOLBITS, + (buf + 1)^ Shr TRUCOLBITS, + (buf + 2)^ Shr TRUCOLBITS); + Inc(scr, 2); + Inc(buffer, 2); + End; + Inc(buffer, 160); + End; +End; + +Procedure dump_320x(y0, y1 : Integer; buffer : PInteger); + +Var + x, y, yd, r, g, b, xx, yy : Integer; + buf : PByte; + scr : DWord; + +Begin + buf := PByte(buffer); + scr := $b8000 + (y0 * 160); + yd := y1 - y0; + For y := 0 To yd - 1 Do + Begin + For x := 0 To 79 Do + Begin + r := 0; g := 0; b:= 0; + xx := 0; + While xx < 4 * 4 Do + Begin + yy := 0; + While yy < 4 * 4 * 320 Do + Begin + Inc(r, (buf + xx + yy + 0)^); + Inc(g, (buf + xx + yy + 1)^); + Inc(b, (buf + xx + yy + 2)^); + Inc(yy, 320 * 4); + End; + Inc(xx, 4); + End; + MemW[scr] := COLMAP_(r Shr (TRUCOLBITS + 4), + g Shr (TRUCOLBITS + 4), + b Shr (TRUCOLBITS + 4)); + Inc(scr, 2); + Inc(buf, 4 * 4); + End; + Inc(buf, 80 * 4 * 4 * 3); + End; +End; + +End. diff --git a/packages/ptc/src/dos/timeunit/timeunit.pp b/packages/ptc/src/dos/timeunit/timeunit.pp new file mode 100644 index 0000000000..17dd5419b4 --- /dev/null +++ b/packages/ptc/src/dos/timeunit/timeunit.pp @@ -0,0 +1,139 @@ +{$MODE objfpc} +{$ASMMODE intel} +{$goto on} + +Unit timeunit; + +Interface + +Type + TGetClockTics = Function : QWord; + +Var + TimerResolution : Double; + CPS : Double; + GetClockTics : TGetClockTics; + +Implementation + +Var + UseRDTSC : Boolean; + Clk1Lo, Clk1Hi, Clk2Lo, Clk2Hi : DWord; + Clk1, Clk2 : QWord; + ClkDelta : QWord; + CpuFlags : DWord; + +Function GetClockTics_RDTSC : QWord; Assembler; + +Asm + rdtsc +End; + +Function GetClockTics_LAME : QWord; + +Begin + GetClockTics_LAME := MemL[$46C]; +End; + +Procedure DetectCPUSpeed_RDTSC; + +Begin + {word absolute $46C} + Asm + mov di, fs:[046Ch] +@@1: + cmp di, fs:[046Ch] + je @@1 + rdtsc + mov ebx, eax + mov ecx, edx + mov di, fs:[046Ch] +@@2: + mov ax, fs:[046Ch] + sub ax, di + cmp ax, 32 + jb @@2 + rdtsc + mov [Clk1Lo], ebx + mov [Clk1Hi], ecx + mov [Clk2Lo], eax + mov [Clk2Hi], edx + End ['EAX','EBX','ECX','EDX','EDI']; +{ Clk1 := Clk1Lo Or (QWord(Clk1Hi) Shl 32); + Clk2 := Clk2Lo Or (QWord(Clk2Hi) Shl 32);} + Clk1 := Clk1Hi; + Clk1 := Clk1 Shl 32; + Clk1 := Clk1 + Clk1Lo; + Clk2 := Clk2Hi; + Clk2 := Clk2 Shl 32; + Clk2 := Clk2 + Clk2Lo; + ClkDelta := Clk2 - Clk1; + CPS := (ClkDelta * 18.2) / 32; + TimerResolution := 1 / CPS; +End; + +Procedure _CPU; Assembler; + +Label + nocpuid; + +Asm + mov CpuFlags, 0 + pushf + pop eax + mov ecx, eax + xor eax, 40000h + push eax + popf + pushf + pop eax + xor eax, ecx + jz nocpuid + push ecx + popf + mov eax, ecx + xor eax, 200000h + push eax + popf + pushf + pop eax + xor eax, ecx + je nocpuid + + pusha + mov eax, 1 + cpuid + mov CpuFlags, edx + popa + +nocpuid: +End; + +Procedure DetectCPU; + +Begin + _CPU; + If (CpuFlags And $10) <> 0 Then + UseRDTSC := True + Else + UseRDTSC := False; + + If UseRDTSC Then + Begin + DetectCPUSpeed_RDTSC; + GetClockTics := @GetClockTics_RDTSC; + End + Else + Begin + TimerResolution := 1 / 18.2; + GetClockTics := @GetClockTics_LAME; + End; +End; + +Initialization + +Begin + DetectCPU; +End; + +End. diff --git a/packages/ptc/src/dos/vesa/console.inc b/packages/ptc/src/dos/vesa/console.inc new file mode 100644 index 0000000000..b341806e0f --- /dev/null +++ b/packages/ptc/src/dos/vesa/console.inc @@ -0,0 +1,917 @@ +{$MACRO ON} + +{$DEFINE DEFAULT_WIDTH:=320} +{$DEFINE DEFAULT_HEIGHT:=200} +{$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)} +{ $DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF)} + +Constructor VESAConsole.Create; + +Var + I, J : Integer; + r, g, b, a : DWord; + tmpbpp : Integer; + tmp : TPTCFormat; + +Begin + m_modes := Nil; + m_modes_n := Nil; + m_keyboard := Nil; + m_open := False; + m_locked := False; + m_default_format := Nil; + m_palette := Nil; + m_copy := Nil; + m_area := Nil; + m_clip := Nil; + m_title := ''; + m_information := ''; + m_default_width := DEFAULT_WIDTH; + m_default_height := DEFAULT_HEIGHT; + m_default_format := DEFAULT_FORMAT; + + InitVESA; + m_primary := Nil; + + m_modes_last := -1; + For I := 0 To NrOfModes Do + With ModeInfo[I].VesaModeInfo Do + If (MemoryModel = 6) And + ((BitsPerPixel = 8) Or + (BitsPerPixel = 15) Or + (BitsPerPixel = 16) Or + (BitsPerPixel = 24) Or + (BitsPerPixel = 32)) Then + Inc(m_modes_last) + Else + If (MemoryModel = 4) And (BitsPerPixel = 8) Then + Inc(m_modes_last, 2); + GetMem(m_modes, (m_modes_last + 2) * SizeOf(TPTCMode)); + FillChar(m_modes^, (m_modes_last + 2) * SizeOf(TPTCMode), 0); + GetMem(m_modes_n, (m_modes_last + 1) * SizeOf(Integer)); +// Writeln(m_modes_last, ' ', NrOfModes); + m_modes[m_modes_last + 1] := TPTCMode.Create; {mark end of list!} + J := -1; + For I := 0 To NrOfModes Do + With ModeInfo[I].VesaModeInfo Do + If (MemoryModel = 6) And + ((BitsPerPixel = 8) Or + (BitsPerPixel = 15) Or + (BitsPerPixel = 16) Or + (BitsPerPixel = 24) Or + (BitsPerPixel = 32)) Then + Begin + Inc(J); + r := MakeMask(RedMaskSize, RedFieldPosition); + g := MakeMask(GreenMaskSize, GreenFieldPosition); + b := MakeMask(BlueMaskSize, BlueFieldPosition); + {a := MakeMask(RsvdMaskSize, RsvdFieldPosition);} + a := 0; + If BitsPerPixel = 15 Then + tmpbpp := 16 + Else + tmpbpp := BitsPerPixel; + tmp := TPTCFormat.Create(tmpbpp, r, g, b, a); + Try + m_modes[J] := TPTCMode.Create(XResolution, YResolution, tmp); + m_modes_n[J] := I; + Finally + tmp.Destroy; + End; +{ Inc(m_modes_last)} + End + Else + If (MemoryModel = 4) And (BitsPerPixel = 8) Then + Begin + Inc(J); + tmp := TPTCFormat.Create(8); + Try + m_modes[J] := TPTCMode.Create(XResolution, YResolution, tmp); + m_modes_n[J] := I; + Finally + tmp.Destroy; + End; + Inc(J); + tmp := TPTCFormat.Create(8, $E0, $1C, $03); {RGB 332} + Try + m_modes[J] := TPTCMode.Create(XResolution, YResolution, tmp); + m_modes_n[J] := I; + Finally + tmp.Destroy; + End; +{ Inc(m_modes_last, 2);} + End; + + m_clip := TPTCArea.Create; + m_area := TPTCArea.Create; + m_copy := TPTCCopy.Create; + m_palette := TPTCPalette.Create; + configure('ptc.cfg'); +End; + +Destructor VESAConsole.Destroy; + +Var + I : Integer; + +Begin + close; + If m_modes <> Nil Then + For I := 0 To m_modes_last + 1 Do + If m_modes[I] <> Nil Then + m_modes[I].Destroy; + If m_modes <> Nil Then + FreeMem(m_modes); + If m_modes_n <> Nil Then + FreeMem(m_modes_n); + If m_keyboard <> Nil Then + m_keyboard.Destroy; + If m_copy <> Nil Then + m_copy.Destroy; + If m_default_format <> Nil Then + m_default_format.Destroy; + If m_palette <> Nil Then + m_palette.Destroy; + If m_area <> Nil Then + m_area.Destroy; + If m_clip <> Nil Then + m_clip.Destroy; + Inherited Destroy; +End; + +Procedure VESAConsole.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + ASSignFile(F, _file); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + option(S); + End; + CloseFile(F); +End; + +Function VESAConsole.option(Const _option : String) : Boolean; + +Begin + {...} + option := m_copy.option(_option); +End; + +Function VESAConsole.modes : PPTCMode; + +Begin + {todo...} + modes := m_modes; +End; + +Procedure VESAConsole.open(Const _title : String; _pages : Integer); Overload; + +Begin + open(_title, m_default_format, _pages); +End; + +Procedure VESAConsole.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; + +Begin + open(_title, m_default_width, m_default_height, _format, _pages); +End; + +Procedure VESAConsole.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; + +Var + m : TPTCMode; + +Begin + m := TPTCMode.Create(_width, _height, _format); + Try + open(_title, m, _pages); + Finally + m.Destroy; + End; +End; + +Procedure VESAConsole.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; + +Var +{ _width, _height : Integer; + _format : TPTCFormat;} + I : Integer; + modefound, bestmodefound : Integer; + x, y, bpp : Integer; + +Begin + If Not _mode.valid Then + Raise TPTCError.Create('invalid mode'); + modefound := -1; + For I := 0 To m_modes_last Do + If m_modes[I].Equals(_mode) Then + Begin + modefound := I; + Break; + End; +{ If modefound = -1 Then + Raise TPTCError.Create('mode not found >:)');} + bestmodefound := -1; + If (modefound = -1) And (_mode.format.direct) Then + Begin + x := 100000000; + y := x; + bpp := -1; + For I := 0 To m_modes_last Do + If (m_modes[i].width >= _mode.width) And + (m_modes[i].height >= _mode.height) And + (m_modes[i].width <= x) And + (m_modes[i].height <= y) And + (((m_modes[i].format.bits >= bpp) And + (bpp < _mode.format.bits)) Or + ((m_modes[i].format.bits < bpp) And + (m_modes[i].format.bits >= _mode.format.bits) And + (bpp > _mode.format.bits))) Then + Begin + bestmodefound := I; + x := m_modes[i].width; + y := m_modes[i].height; + bpp := m_modes[i].format.bits; + End; +{ If m_modes[I].bpp >= Then + Begin + modefound := I; + Break; + End;} + End; + If (modefound = -1) And (_mode.format.indexed) Then + Begin + x := 100000000; + y := x; + bpp := -1; + For I := 0 To m_modes_last Do + If (m_modes[i].width >= _mode.width) And + (m_modes[i].height >= _mode.height) And + (m_modes[i].width <= x) And + (m_modes[i].height <= y) { And + (((m_modes[i].format.bits >= bpp) And + (bpp < _mode.format.bits)) Or + ((m_modes[i].format.bits < bpp) And + (m_modes[i].format.bits >= _mode.format.bits) And + (bpp > _mode.format.bits)))} Then + Begin + If (m_modes[i].width <> x) Or (m_modes[i].height <> y) Then + bpp := -1; + If m_modes[i].format.indexed Or + (m_modes[i].format.bits > bpp) Then + Begin + bestmodefound := I; + x := m_modes[i].width; + y := m_modes[i].height; + bpp := m_modes[i].format.bits; + If m_modes[i].format.indexed Then + bpp := 1000; + End; + End; +{ If m_modes[I].bpp >= Then + Begin + modefound := I; + Break; + End;} + End; + If bestmodefound <> -1 Then + modefound := bestmodefound; +// Writeln('mf', modefound); +// Readln; + If modefound = -1 Then + Raise TPTCError.Create('mode not found >:)'); +{ _width := _mode.width; + _height := _mode.height; + _format := _mode.format;} +{ m_CurrentMode := modefound;} +{ m_VESACurrentMode := m_modes_n[modefound];} + internal_pre_open_setup(_title); + internal_open_fullscreen_start; + internal_open_fullscreen(modefound{m_CurrentMode}); + internal_open_fullscreen_finish(_pages); + internal_post_open_setup; +End; + +Procedure VESAConsole.close; + +Begin + If m_open Then + Begin + If m_locked Then + Raise TPTCError.Create('console is still locked'); + {flush all key presses} + While KeyPressed Do ReadKey; + internal_close; + m_open := False; + End; +End; + +Procedure VESAConsole.flush; + +Begin + check_open; + check_unlocked; +End; + +Procedure VESAConsole.finish; + +Begin + check_open; + check_unlocked; +End; + +Procedure VESAConsole.update; + +Var + framebuffer : PInteger; + +Begin + check_open; + check_unlocked; + WriteToVideoMemory(m_primary, 0, m_pitch * m_height); +{ m_primary.clear;} +{ m_primary.copy(m_160x100buffer); + framebuffer := m_160x100buffer.lock; + dump_160x(0, 50, framebuffer); + m_160x100buffer.unlock;} +End; + +Procedure VESAConsole.update(Const _area : TPTCArea); + +Begin + update; +End; + +Procedure VESAConsole.internal_ReadKey(k : TPTCKey); + +Begin + check_open; + m_keyboard.internal_ReadKey(k); +End; + +Function VESAConsole.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + check_open; + Result := m_keyboard.internal_PeekKey(k); +End; + +Procedure VESAConsole.copy(Var surface : TPTCBaseSurface); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Procedure VESAConsole.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Var + pixels : Pointer; + +Begin + check_open; + check_unlocked; + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette, source, destination); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Function VESAConsole.lock : Pointer; + +Var + pixels : Pointer; + +Begin + check_open; + If m_locked Then + Raise TPTCError.Create('console is already locked'); +{ pixels := m_primary.lock;} + pixels := m_primary; + m_locked := True; + lock := pixels; +End; + +Procedure VESAConsole.unlock; + +Begin + check_open; + If Not m_locked Then + Raise TPTCError.Create('console is not locked'); +{ m_primary.unlock;} + m_locked := False; +End; + +Procedure VESAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + check_open; + check_unlocked; + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0, + width, height, pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + load(pixels, _width, _height, _pitch, _format, _palette, Area_, area); + Finally + Area_.Destroy; + End; + End; +End; + +Procedure VESAConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination); + Finally + tmp.Destroy; + End; + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console area', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Destroy; + If clipped_destination <> Nil Then + clipped_destination.Destroy; + End; +End; + +Procedure VESAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + check_open; + check_unlocked; + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0, + _width, _height, _pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to save console pixels', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + save(pixels, _width, _height, _pitch, _format, _palette, area, Area_); + Finally + Area_.Destroy; + End; + End; +End; + +Procedure VESAConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination); + Finally + tmp.Destroy; + End; + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch, + pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to save console area pixels', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Destroy; + If clipped_destination <> Nil Then + clipped_destination.Destroy; + End; +End; + +Procedure VESAConsole.clear; + +Var + tmp : TPTCColor; + +Begin + check_open; + check_unlocked; + If format.direct Then + tmp := TPTCColor.Create(0, 0, 0, 0) + Else + tmp := TPTCColor.Create(0); + Try + clear(tmp); + Finally + tmp.Destroy; + End; +End; + +Procedure VESAConsole.clear(Const color : TPTCColor); + +Var + tmp : TPTCArea; + +Begin + check_open; + check_unlocked; + tmp := TPTCArea.Create; + Try + clear(color, tmp); + Finally + tmp.Destroy; + End; +End; + +Procedure VESAConsole.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin + check_open; + check_unlocked; + {...} +End; + +Procedure VESAConsole.palette(Const _palette : TPTCPalette); + +Begin + check_open; +{ m_primary.palette(_palette);} + If format.indexed Then + Begin + m_palette.load(_palette.data); + SetPalette(_palette.data, 0, 256); + End; +End; + +Function VESAConsole.palette : TPTCPalette; + +Begin + check_open; + palette := m_palette; +{ palette := m_primary.palette;} +End; + +Procedure VESAConsole.clip(Const _area : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + check_open; + tmp := TPTCClipper.clip(_area, m_area); + Try + m_clip.Assign(tmp); + Finally + tmp.Destroy; + End; +End; + +Function VESAConsole.width : Integer; + +Begin + check_open; + width := m_width; +End; + +Function VESAConsole.height : Integer; + +Begin + check_open; + height := m_height; +End; + +Function VESAConsole.pitch : Integer; + +Begin + check_open; + pitch := m_pitch; +End; + +Function VESAConsole.pages : Integer; + +Begin + check_open; + pages := 2;{m_primary.pages;} +End; + +Function VESAConsole.area : TPTCArea; + +Begin + check_open; + area := m_area; +{ area := m_primary.area;} +End; + +Function VESAConsole.clip : TPTCArea; + +Begin + check_open; + clip := m_clip; +{ clip := m_primary.clip;} +End; + +Function VESAConsole.format : TPTCFormat; + +Begin + check_open; + format := m_modes[m_CurrentMode].format; +{ format := m_primary.format;} +End; + +Function VESAConsole.name : String; + +Begin + name := 'VESA'; +End; + +Function VESAConsole.title : String; + +Begin + title := m_title; +End; + +Function VESAConsole.information : String; + +Begin + information := m_information; +End; + +Procedure VESAConsole.internal_pre_open_setup(Const _title : String); + +Begin + internal_close; + m_title := _title; +End; + +Procedure VESAConsole.internal_open_fullscreen_start; + +{Var + f : TPTCFormat;} + +Begin +{ f := TPTCFormat.Create(32, $0000FF, $00FF00, $FF0000);} +{ m_160x100buffer := TPTCSurface.Create(160, 100, f);} +{ f.Destroy;} +{ set80x50;} +End; + +Procedure VESAConsole.internal_open_fullscreen(ModeNr : Integer); + +Var + tmp : TPTCFormat; + tmpa : TPTCArea; + I : Integer; + plt : Array[0..255] Of Packed Record + B, G, R, A : Byte; + End; + +Begin + m_CurrentMode := ModeNr; + m_VESACurrentMode := m_modes_n[ModeNr]; + SetVESAMode(m_VESACurrentMode); + tmp := TPTCFormat.Create(8, $E0, $1C, $03); + If m_modes[m_CurrentMode].m_format.Equals(tmp) Then + Begin + For I := 0 To 255 Do + With plt[I] Do + Begin + Case I Shr 5 Of + 0 : R := 0; + 1 : R := 36; + 2 : R := 73; + 3 : R := 109; + 4 : R := 146; + 5 : R := 182; + 6 : R := 219; + 7 : R := 255; + End; + Case (I Shr 2) And 7 Of + 0 : G := 0; + 1 : G := 36; + 2 : G := 73; + 3 : G := 109; + 4 : G := 146; + 5 : G := 182; + 6 : G := 219; + 7 : G := 255; + End; + Case I And 3 Of + 0 : B := 0; + 1 : B := 85; + 2 : B := 170; + 3 : B := 255; + End; + A := 0; + End; + SetPalette(@plt, 0, 256); + End; + tmp.Destroy; +{ m_primary := TPTCSurface.Create(_width, _height, _format);} + With ModeInfo[m_VESACurrentMode].VesaModeInfo Do + Begin + m_width := XResolution; + m_height := YResolution; + m_pitch := BytesPerScanline; + End; + tmpa := TPTCArea.Create(0, 0, width, height); + Try + m_area.ASSign(tmpa); + m_clip.ASSign(tmpa); + Finally + tmpa.Destroy; + End; +End; + +Procedure VESAConsole.internal_open_fullscreen_finish(_pages : Integer); + +Begin + m_primary := GetMem(m_height * m_pitch); +End; + +Procedure VESAConsole.internal_post_open_setup; + +Begin + If m_keyboard <> Nil Then + m_keyboard.Destroy; + m_keyboard := TDosKeyboard.Create; + + { temporary platform dependent information fudge } + m_information := 'dos version x.xx.x'+#13+#10+'vesa version x.xx'+#13+#10+'vesa driver name xxxxx'+#13+#10+'display driver vendor xxxxx'+#13+#10+'certified driver? x'+#13+#10; + + { set open flag } + m_open := True; +End; + +Procedure VESAConsole.internal_reset; + +Begin + If m_keyboard <> Nil Then + Begin + m_keyboard.Destroy; + m_keyboard := Nil; + End; +End; + +Procedure VESAConsole.internal_close; + +Begin + If m_primary <> Nil Then + Begin + FreeMem(m_primary); + m_primary := Nil; + End; + If m_keyboard <> Nil Then + Begin + m_keyboard.Destroy; + m_keyboard := Nil; + End; + RestoreTextMode; +End; + +Procedure VESAConsole.check_open; + +Begin + {$IFDEF DEBUG} + If Not m_open Then + Raise TPTCError.Create('console is not open'); + {$ELSE} + {$ENDIF} +End; + +Procedure VESAConsole.check_unlocked; + +Begin + {$IFDEF DEBUG} + If m_locked Then + Raise TPTCError.Create('console is not unlocked'); + {$ELSE} + {$ENDIF} +End; diff --git a/packages/ptc/src/dos/vesa/consoled.inc b/packages/ptc/src/dos/vesa/consoled.inc new file mode 100644 index 0000000000..c7fbc7e100 --- /dev/null +++ b/packages/ptc/src/dos/vesa/consoled.inc @@ -0,0 +1,114 @@ +Type + VESAConsole = Class(TPTCBaseConsole) + Private + { internal console management routines } + Procedure internal_pre_open_setup(Const _title : String); + Procedure internal_open_fullscreen_start; + Procedure internal_open_fullscreen(ModeNr : Integer); + Procedure internal_open_fullscreen_finish(_pages : Integer); + Procedure internal_post_open_setup; + Procedure internal_reset; + Procedure internal_close; + + { console debug checks } + Procedure check_open; + Procedure check_unlocked; + + { data } +{ m_modes : Array[0..255] Of TPTCMode;} + m_modes : PPTCMode; + m_modes_last : Integer; + m_modes_n : PInteger; + m_title : String; + m_information : String; + m_CurrentMode : Integer; + m_VESACurrentMode : Integer; + m_width, m_height, m_pitch, m_pages : Integer; + m_primary : Pointer; + + { flags } + m_open : Boolean; + m_locked : Boolean; + + { option data } + m_default_width : Integer; + m_default_height : Integer; + m_default_pages : Integer; + m_default_format : TPTCFormat; + + { objects } + m_copy : TPTCCopy; + m_area : TPTCArea; + m_clip : TPTCArea; + m_format : TPTCFormat; + + m_clear : TPTCClear; + m_palette : TPTCPalette; + + { Dos objects } +{ m_primary : TPTCSurface;} +{ DosKeyboard *m_keyboard;} + m_keyboard : TDosKeyboard; +{ m_160x100buffer : TPTCSurface;} + Protected + Procedure internal_ReadKey(k : TPTCKey); Override; + Function internal_PeekKey(k : TPTCKey) : Boolean; Override; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; Override; + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function width : Integer; Override; + Function height : Integer; Override; + Function pitch : Integer; Override; + Function pages : Integer; Override; + Function area : TPTCArea; Override; + Function clip : TPTCArea; Override; + Function format : TPTCFormat; Override; + Function name : String; Override; + Function title : String; Override; + Function information : String; Override; + End; diff --git a/packages/ptc/src/dos/vesa/vesa.pp b/packages/ptc/src/dos/vesa/vesa.pp new file mode 100644 index 0000000000..cc7a65845d --- /dev/null +++ b/packages/ptc/src/dos/vesa/vesa.pp @@ -0,0 +1,1109 @@ +{$MODE objfpc} +{$ASMMODE intel} + +{ $DEFINE DEBUGOUTPUT} + +Unit vesa; + +Interface + +Type + TVesaModeInfoBlock = Packed Record + {Mandatory information for all VBE revisions} + ModeAttributes : Word; {mode attributes} + WinAAttributes : Byte; {window A attributes} + WinBAttributes : Byte; {window B attributes} + WinGranularity : Word; {window granularity} + WinSize : Word; {window size} + WinASegment : Word; {window A start segment} + WinBSegment : Word; {window B start segment} + WinFuncPtr : DWord; {real mode pointer to window function} + BytesPerScanLine : Word; {bytes per scan line} + + {Mandatory information for VBE 1.2 and above} + XResolution : Word; {horizontal resolution in pixels or characters} + YResolution : Word; {vertical resolution in pixels or characters} + XCharSize : Byte; {character cell width in pixels} + YCharSize : Byte; {character cell height in pixels} + NumberOfPlanes : Byte; {number of memory planes} + BitsPerPixel : Byte; {bits per pixel} + NumberOfBanks : Byte; {number of banks} + MemoryModel : Byte; {memory model type} + BankSize : Byte; {bank size in KB} + NumberOfImagePages : Byte; {number of images} + Reserved : Byte;{=1} {reserved for page function} + + {Direct color fields (required for direct/6 and YUV/7 memory models)} + RedMaskSize : Byte; {size of direct color red mask in bits} + RedFieldPosition : Byte; {bit position of lsb of red mask} + GreenMaskSize : Byte; {size of direct color green mask in bits} + GreenFieldPosition : Byte; {bit position of lsb of green mask} + BlueMaskSize : Byte; {size of direct color blue mask in bits} + BlueFieldPosition : Byte; {bit position of lsb of blue mask} + RsvdMaskSize : Byte; {size of direct color reserved mask in bits} + RsvdFieldPosition : Byte; {bit position of lsb of reserved mask} + DirectColorModeInfo : Byte; {direct color mode attributes} + + {Mandatory information for VBE 2.0 and above} + PhysBasePtr : DWord; {physical address for flat memory frame buffer} + Reserved2 : DWord;{=0} {Reserved - always set to 0} + Reserved3 : Word;{=0} {Reserved - always set to 0} + + {Mandatory information for VBE 3.0 and above} + LinBytesPerScanLine : Word; {bytes per scan line for linear modes} + BnkNumberOfImagePages : Byte; {number of images for banked modes} + LinNumberOfImagePages : Byte; {number of images for linear modes} + LinRedMaskSize : Byte; {size of direct color red mask (linear modes)} + LinRedFieldPosition : Byte; {bit position of lsb of red mask (linear modes)} + LinGreenMaskSize : Byte; {size of direct color green mask (linear modes)} + LinGreenFieldPosition : Byte; {bit position of lsb of green mask (linear modes)} + LinBlueMaskSize : Byte; {size of direct color blue mask (linear modes)} + LinBlueFieldPosition : Byte; {bit position of lsb of blue mask (linear modes)} + LinRsvdMaskSize : Byte; {size of direct color reserved mask (linear modes)} + LinRsvdFieldPosition : Byte; {bit position of lsb of reserved mask (linear modes)} + MaxPixelClock : DWord; {maximum pixel clock (in Hz) for graphics mode} + + Reserved4 : Array[1..189] Of Byte; {remainder of ModeInfoBlock} + End; + PModeInfo = ^TModeInfo; + TModeInfo = Record + ModeNumber : DWord; + VesaModeInfo : TVesaModeInfoBlock; + End; + +Var + ModeInfo : PModeInfo; + NrOfModes : Integer; + VBEPresent : Boolean; + +Procedure InitVESA; +Function SetVESAMode(M : Integer) : Boolean; +Procedure RestoreTextMode; +Procedure WriteToVideoMemory(Src : Pointer; Dest : DWord; Size : DWord); +Procedure SetPalette(Palette : Pointer; First, Num : Integer); +Procedure GetPalette(Palette : Pointer; First, Num : Integer); +Function MakeMask(MaskSize, FieldPosition : Integer) : DWord; + +Implementation + +Uses + go32; + +Type + TVBEInfoBlock = Packed Record + {VBE 1.0+} + VBESignature : DWord; {'VESA'} + VBEVersion : Word; + OemStringPtr : DWord; {VbeFarPtr to OEM String} + Capabilities : DWord; {Capabilities of graphics controller} + VideoModePtr : DWord; {VbeFarPtr to VideoModeList} + {added for VBE 1.1+} + TotalMemory : Word; {Number of 64kb memory blocks} + {added for VBE 2.0+} + OemSoftwareRev : Word; {VBE implementation Software revision} + OemVendorNamePtr : DWord; {VbeFarPtr to Vendor Name String} + OemProductNamePtr : DWord; {VbeFarPtr to Product Name String} + OemProductRevPtr : DWord; {VbeFarPtr to Product Revision String} + Reserved : Array[1..222] Of Byte; {Reserved for VBE implementation scratch area} + OemData : Array[1..256] Of Char; {Data Area for OEM Strings} + End; + +Var + VBEInfoBlock : TVBEInfoBlock; + VideoMemory : DWord; + EightBitDACSupported : Boolean; + nonVGA : Boolean; + SnowyRAMDAC : Boolean; + StereoSignalingSupport : Boolean; + StereoSignalingVesaEVC : Boolean; + OEMString : String; + OEMVendorName : String; + OEMProductName : String; + OEMProductRev : String; + OEMSoftwareRev : Integer; + CurrentMode : Integer; + LFBUsed : Boolean; + UseLFB : Boolean; + + RealModePaletteSel : Word; + RealModePaletteSeg : Word; + SetPaletteHW : Boolean; + PaletteDACbits : Integer; + + ReadWindow, WriteWindow : Integer; + ReadWindowStart, WriteWindowStart : Integer; + ReadWindowAddress, WriteWindowAddress : Integer; + WindowGranularity : DWord; + WindowSize, WindowSizeG : DWord; + + VESAInit : Boolean; + + RealRegs : TRealRegs; + + temp : Pointer; + +Procedure StandardMode(ModeNumber : DWord; Var ModeInfo : TVesaModeInfoBlock); + +Begin +{ +100 640x400x256 +101 640x480x256 +102 800x600x16 +103 800x600x256 +104 1024x768x16 +105 1024x768x256 +106 1280x1024x16 +107 1280x1024x256 +108 80x60t +109 132x25t +10A 132x43t +10B 132x50t +10C 132x60t +10D 320x200x32k +10E 320x200x64k +10F 320x200x16.8m +110 640x480x32k +111 640x480x64k +112 640x480x16.8m +113 800x600x32k +114 800x600x64k +115 800x600x16.8m +116 1024x768x32k +117 1024x768x64k +118 1024x768x16.8m +119 1280x1024x32k +11A 1280x1024x64k +11B 1280x1024x16.8m +} + With ModeInfo Do + Begin + ModeAttributes := ModeAttributes Or 2; + Case ModeNumber Of + $100 : Begin + XResolution := 640; + YResolution := 400; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 1; + BitsPerPixel := 8; + MemoryModel := 4; + End; + $101 : Begin + XResolution := 640; + YResolution := 480; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 1; + BitsPerPixel := 8; + MemoryModel := 4; + End; + $102 : Begin + XResolution := 800; + YResolution := 600; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 3; + End; + $103 : Begin + XResolution := 800; + YResolution := 600; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 1; + BitsPerPixel := 8; + MemoryModel := 4; + End; + $104 : Begin + XResolution := 1024; + YResolution := 768; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 3; + End; + $105 : Begin + XResolution := 1024; + YResolution := 768; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 1; + BitsPerPixel := 8; + MemoryModel := 4; + End; + $106 : Begin + XResolution := 1280; + YResolution := 1024; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 3; + End; + $107 : Begin + XResolution := 1280; + YResolution := 1024; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 1; + BitsPerPixel := 8; + MemoryModel := 4; + End; + $108 : Begin + XResolution := 80; + YResolution := 60; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 0; + End; + $109 : Begin + XResolution := 132; + YResolution := 25; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 0; + End; + $10A : Begin + XResolution := 132; + YResolution := 43; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 0; + End; + $10B : Begin + XResolution := 132; + YResolution := 50; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 0; + End; + $10C : Begin + XResolution := 132; + YResolution := 60; + XCharSize := 8; + YCharSize := 16; + NumberOfPlanes := 4; + BitsPerPixel := 4; + MemoryModel := 0; + End; + {todo:10D..11B} + Else + ModeAttributes := ModeAttributes And $FFFD; + End; +// NumberOfImagePages := 0;{...} + End; +End; + +Function bcd(q : Integer) : Integer; + +Begin + q := q And $FF; + If ((q And $F) < 10) And ((q Shr 4) < 10) Then + bcd := (q And $F) + (q Shr 4) * 10 + Else + bcd := q; +End; + +Procedure DisposeRealModePalette; + +Begin + If RealModePaletteSel = 0 Then + Exit; + global_dos_free(RealModePaletteSel); + RealModePaletteSel := 0; + RealModePaletteSeg := 0; +End; + +Procedure AllocateRealModePalette; + +Var + Addr : DWord; + +Begin + DisposeRealModePalette; + Addr := global_dos_alloc(256*4); + RealModePaletteSeg := Addr Shr 16; + RealModePaletteSel := Addr And $FFFF; +End; + +Procedure SetPalette2(Palette : Pointer; Num : Integer); Assembler; + +Asm + push es + + cld + mov ax, fs + mov es, ax + mov esi, [Palette] + movzx edi, word [RealModePaletteSeg] + shl edi, 4 + mov ecx, Num +{ mov edx, 03F3F3F3Fh} + mov edx, 0003F3F3Fh + +@@1: + lodsd + + shr eax, 2 {convert 8->6bit} + and eax, edx + + stosd + dec ecx + jnz @@1 + + pop es +End; + +Procedure SetPalette3(Palette : Pointer; Num : Integer); Assembler; + +Asm + push es + + cld + mov ax, fs + mov es, ax + mov esi, [Palette] + movzx edi, word [RealModePaletteSeg] + shl edi, 4 + mov ecx, Num +{ mov edx, 07F7F7F7Fh} + mov edx, 0007F7F7Fh + +@@1: + lodsd + + shr eax, 1 {convert 8->7bit} + and eax, edx + + stosd + dec ecx + jnz @@1 + + pop es +End; + +Procedure SetPaletteHW6(Palette : Pointer; First, Num : Integer); + +Var + I : Integer; + p : PDWord; + c : DWord; + +Begin + p := PDWord(Palette); + outportb($3C8, First); + While Num > 0 Do + Begin + c := (p^ Shr 2) And $3F3F3F; + outportb($3C9, c Shr 16); + outportb($3C9, c Shr 8); + outportb($3C9, c); + + Inc(p); + Dec(Num); + End; +End; + +Procedure SetPaletteHW7(Palette : Pointer; First, Num : Integer); + +Var + I : Integer; + p : PDWord; + c : DWord; + +Begin + p := PDWord(Palette); + outportb($3C8, First); + While Num > 0 Do + Begin + c := (p^ Shr 1) And $7F7F7F; + outportb($3C9, c Shr 16); + outportb($3C9, c Shr 8); + outportb($3C9, c); + + Inc(p); + Dec(Num); + End; +End; + +Procedure SetPaletteHW8(Palette : Pointer; First, Num : Integer); + +Var + I : Integer; + p : PDWord; + +Begin + p := PDWord(Palette); + outportb($3C8, First); + While Num > 0 Do + Begin + outportb($3C9, p^ Shr 16); + outportb($3C9, p^ Shr 8); + outportb($3C9, p^); + + Inc(p); + Dec(Num); + End; +End; + +Procedure SetPalette(Palette : Pointer; First, Num : Integer); + +Begin + If SetPaletteHW Then + Begin + Case PaletteDACbits Of + 8 : SetPaletteHW8(Palette, First, Num); + 7 : SetPaletteHW7(Palette, First, Num); + 6 : SetPaletteHW6(Palette, First, Num); + End; + End + Else + Begin + If PaletteDACbits = 8 Then + dosmemput(RealModePaletteSeg, 0, Palette^, Num * 4) {8bits} + Else + If PaletteDACbits = 7 Then + SetPalette3(Palette, Num) {7bits} + Else + SetPalette2(Palette, Num); {6bits} + RealRegs.ax := $4F09; + RealRegs.bl := 0; + RealRegs.cx := Num; + RealRegs.dx := First; + RealRegs.es := RealModePaletteSeg; + RealRegs.di := 0; + realintr($10, RealRegs); + End; +End; + +Procedure GetPalette(Palette : Pointer; First, Num : Integer); + +Begin + RealRegs.ax := $4F09; + RealRegs.bl := 1; + RealRegs.cx := Num; + RealRegs.dx := First; + RealRegs.es := RealModePaletteSeg; + RealRegs.di := 0; + realintr($10, RealRegs); + {...} +End; + +Procedure SwitchTo8bitDAC; + +Begin + RealRegs.ax := $4F08; + RealRegs.bl := 0; + RealRegs.bh := 8; + realintr($10, RealRegs); + PaletteDACbits := RealRegs.bh; + If PaletteDACbits < 6 Then + PaletteDACbits := 6; +End; + +Function MakeMask(MaskSize, FieldPosition : Integer) : DWord; + +Var + Mask : DWord; + I : Integer; + +Begin + Mask := 1 Shl FieldPosition; + For I := 2 To MaskSize Do + Mask := Mask Or (Mask Shl 1); + MakeMask := Mask; +End; + +Function GetRMString(SegOfs : DWord) : String; + +Var + S : String; + C : Char; + Seg, Ofs : Word; + +Begin + If SegOfs = 0 Then + Begin + GetRMString := ''; + Exit; + End; + S := ''; + Ofs := SegOfs And $FFFF; + Seg := SegOfs Shr 16; + Repeat + dosmemget(Seg, Ofs, C, 1); + If C <> #0 Then + Begin + S := S + C; + If Ofs = $FFFF Then + Begin + Ofs := 0; + Inc(Seg, $1000); + End + Else + Inc(Ofs); + End; + Until C = #0; + GetRMString := S; +End; + +Procedure SetWriteWindowStart(WinPos : DWord); + +Begin + RealRegs.ax := $4F05; + RealRegs.bx := WriteWindow; + RealRegs.dx := WinPos; + realintr($10, RealRegs); +End; + +Procedure WriteToVideoMemory(Src : Pointer; Dest : DWord; Size : DWord); + +Var + WW : Integer; + ToDo : Integer; + +Begin + WW := Dest Div WindowGranularity; + Dest := Dest Mod WindowGranularity; +{ Writeln(WindowSize);} + While Size > 0 Do + Begin +{ Write(WW, ' ');} + SetWriteWindowStart(WW); + ToDo := WindowSize - Dest; + If Size < ToDo Then + ToDo := Size; + Asm + push es + mov esi, Src + mov edi, Dest + add edi, WriteWindowAddress + mov ax, fs + mov es, ax + mov ecx, ToDo + shr ecx, 2 + cld + rep movsd + mov ecx, ToDo + and ecx, 3 + jz @@1 + rep movsb +@@1: + pop es + End ['EAX', 'ECX', 'ESI', 'EDI']; + Dest := 0; + Inc(WW, WindowSizeG); +{ Inc(WW);} + Inc(Src, ToDo); + Dec(Size, ToDo); + End; +End; + +{$IFDEF DEBUGOUTPUT} +Procedure WinAttrib(q : Integer); + +Begin + If (q And 1) <> 0 Then + Write(' supported') + Else + Write(' not_supported'); + If (q And 2) <> 0 Then + Write(' readable'); + If (q And 4) <> 0 Then + Write(' writeable'); + Writeln; +End; +{$ENDIF DEBUGOUTPUT} + +Procedure GetModes; + +Type + PModesList = ^TModesList; + TModesList = Record + ModeInfo : TModeInfo; + Next : PModesList; + End; + +Var + First, Last, Run, Tmp : PModesList; + + Procedure AddToList; + + Begin + If Last = Nil Then + Begin + New(Last); + First := Last; + End + Else + Begin + New(Last^.Next); + Last := Last^.Next; + Last^.Next := Nil; + End; + End; + +Var + I : DWord; + Addr : DWord; + AddrSeg, AddrSel : Word; + VesaModeInfo : TVesaModeInfoBlock; + ScanStart, ScanEnd : Integer; + ModeAttr : Integer; + IsModeOk : Boolean; + hasReadWindow, hasWriteWindow : Boolean; + +Begin + NrOfModes := -1; + First := Nil; + Last := Nil; + Addr := global_dos_alloc(512); + AddrSeg := Addr Shr 16; + AddrSel := Addr And $FFFF; + ScanStart := 0; +{ ScanEnd := $7FFF;} {VBE 1.0+ ??} +{ ScanEnd := $3FFF;} {VBE 1.2+ ??} + ScanEnd := $7FF; {VBE 3.0+} + {$IFDEF DEBUGOUTPUT} + Writeln('scanning modes $', HexStr(ScanStart, 4), '..$', HexStr(ScanEnd, 4)); + {$ENDIF DEBUGOUTPUT} + For I := ScanStart To ScanEnd Do + Begin + FillChar(VesaModeInfo, SizeOf(VesaModeInfo), 0); + dosmemput(AddrSeg, 0, VesaModeInfo, SizeOf(VesaModeInfo)); + RealRegs.ax := $4F01; {return VBE mode information} + RealRegs.cx := I; + RealRegs.es := AddrSeg; + RealRegs.di := 0; + realintr($10, RealRegs); + dosmemget(AddrSeg, 0, VesaModeInfo, SizeOf(VesaModeInfo)); + + {display mode info} + {$IFDEF DEBUGOUTPUT} + If ((VesaModeInfo.ModeAttributes And 1) <> 0) Or + (VesaModeInfo.BytesPerScanLine <> 0) Then + Begin + Writeln('ModeNumber: $', HexStr(I, 4)); + Write('ModeAttributes:'); + If (VesaModeInfo.ModeAttributes And 1) <> 0 Then + Write(' supported') + Else + Write(' not_supported'); + If (VesaModeInfo.ModeAttributes And 2) <> 0 Then + Write('') + Else + Write(' reserved_is_zero(noresolutioninfo_for_vbe1.1-)'); + If (VesaModeInfo.ModeAttributes And 4) <> 0 Then + Write(' TTY') + Else + Write(' noTTY'); + If (VesaModeInfo.ModeAttributes And 8) <> 0 Then + Write(' color') + Else + Write(' monochrome'); + If (VesaModeInfo.ModeAttributes And 16) <> 0 Then + Write(' graph') + Else + Write(' text'); + If (VesaModeInfo.ModeAttributes And 32) <> 0 Then + Write(' nonVGA') + Else + Write(' VGA'); + If (VesaModeInfo.ModeAttributes And 64) <> 0 Then + Write(' noWINDOWED') + Else + Write(' WINDOWED'); + If (VesaModeInfo.ModeAttributes And 128) <> 0 Then + Write(' LFB') + Else + Write(' noLFB'); + If (VesaModeInfo.ModeAttributes And 256) <> 0 Then + Write(' DoubleScanMode_is_available') + Else + Write(''); + If (VesaModeInfo.ModeAttributes And 512) <> 0 Then + Write(' InterlacedMode_is_available') + Else + Write(''); + If (VesaModeInfo.ModeAttributes And 1024) <> 0 Then + Write(' TripleBuffering') + Else + Write(''); + If (VesaModeInfo.ModeAttributes And 2048) <> 0 Then + Write(' StereoscopicDisplaySupport') + Else + Write(''); + If (VesaModeInfo.ModeAttributes And 4096) <> 0 Then + Write(' DualDisplayStartAddressSupport') + Else + Write(''); + Writeln; + + Write('WinAAtributes:'); + WinAttrib(VesaModeInfo.WinAAttributes); + Write('WinBAttributes:'); + WinAttrib(VesaModeInfo.WinBAttributes); + Writeln('WinGranularity: ', VesaModeInfo.WinGranularity, ' KB'); + Writeln('WinSize: ', VesaModeInfo.WinSize, ' KB'); + Writeln('WinASegment: $', HexStr(VesaModeInfo.WinASegment, 4)); + Writeln('WinBSegment: $', HexStr(VesaModeInfo.WinBSegment, 4)); + Writeln('WinFuncPtr: ', HexStr(VesaModeInfo.WinFuncPtr Shr 16, 4), ':', HexStr(VesaModeInfo.WinFuncPtr And $FFFF, 4)); + Writeln('BytesPerScanLine: ', VesaModeInfo.BytesPerScanLine); + Writeln('vbe1.2+'); + Writeln('XResolution: ', VesaModeInfo.XResolution); + Writeln('YResolution: ', VesaModeInfo.YResolution); + Writeln('XCharSize: ', VesaModeInfo.XCharSize); + Writeln('YCharSize: ', VesaModeInfo.YCharSize); + Writeln('NumberOfPlanes: ', VesaModeInfo.NumberOfPlanes); + Writeln('BitsPerPixel: ', VesaModeInfo.BitsPerPixel); + Writeln('NumberOfBanks: ', VesaModeInfo.NumberOfBanks); + Write('MemoryModel: '); + Case VesaModeInfo.MemoryModel Of + 0 : Write('Text mode'); + 1 : Write('CGA graphics'); + 2 : Write('Hercules graphics'); + 3 : Write('Planar'); + 4 : Write('Packed pixel'); + 5 : Write('Non-chain 4, 256 color'); + 6 : Write('Direct Color'); + 7 : Write('YUV'); + 8..15 : Write('Reserved, to be defined by VESA'); + Else + Write('To be defined by OEM'); + End; + Writeln('/', VesaModeInfo.MemoryModel); + Writeln('BankSize: ', VesaModeInfo.BankSize, ' KB'); + Writeln('NumberOfImagePages: ', VesaModeInfo.NumberOfImagePages); + Writeln('Reserved(=1): ', VesaModeInfo.Reserved); + Writeln('RedMaskSize: ', VesaModeInfo.RedMaskSize); + Writeln('RedFieldPosition: ', VesaModeInfo.RedFieldPosition); + Writeln('GreenMaskSize: ', VesaModeInfo.GreenMaskSize); + Writeln('GreenFieldPosition: ', VesaModeInfo.GreenFieldPosition); + Writeln('BlueMaskSize: ', VesaModeInfo.BlueMaskSize); + Writeln('BlueFieldPosition: ', VesaModeInfo.BlueFieldPosition); + Writeln('RsvdMaskSize: ', VesaModeInfo.RsvdMaskSize); + Writeln('RsvdFieldPosition: ', VesaModeInfo.RsvdFieldPosition); + Write('DirectColorModeInfo:'); + If (VesaModeInfo.DirectColorModeInfo And 1) <> 0 Then + Write(' Color_ramp_is_programmable') + Else + Write(' Color_ramp_is_fixed'); + If (VesaModeInfo.DirectColorModeInfo And 2) <> 0 Then + Write(' Rsvd_bits_usable_by_app') + Else + Write(' Rsvd_bits_reserved'); + Writeln; + Writeln('vbe2.0+'); + Writeln('PhysBasePtr: $', HexStr(VesaModeInfo.PhysBasePtr, 8)); + Writeln('Reserved2(=0): ', VesaModeInfo.Reserved2); + Writeln('Reserved3(=0): ', VesaModeInfo.Reserved3); + + Writeln; +{ Write(VesaModeInfo.XResolution, 'x', VesaModeInfo.YResolution, 'x', + VesaModeInfo.BitsPerPixel, '-', VesaModeInfo.MemoryModel, + 'R', VesaModeInfo.RedMaskSize, ':', VesaModeInfo.RedFieldPosition, + 'G', VesaModeInfo.GreenMaskSize, ':', VesaModeInfo.GreenFieldPosition, + 'B', VesaModeInfo.BlueMaskSize, ':', VesaModeInfo.BlueFieldPosition, + 'A', VesaModeInfo.RsvdMaskSize, ':', VesaModeInfo.RsvdFieldPosition, ' ');} + End; + {$ENDIF DEBUGOUTPUT} + {/display mode info} + + If (VesaModeInfo.ModeAttributes And 1) <> 0 Then + Begin + If (VesaModeInfo.ModeAttributes And 2) = 0 Then + Begin + If VBEInfoBlock.VBEVersion >= $0102 Then + IsModeOk := False + Else + StandardMode(I, VesaModeInfo); + End; + ModeAttr := (VesaModeInfo.ModeAttributes And $C0) Shr 6; + IsModeOk := True; + If ModeAttr = 1 Then + IsModeOk := False; + If IsModeOk And ((ModeAttr = 0) Or (ModeAttr = 2)) Then + Begin {check windowed} + hasReadWindow := False; + hasWriteWindow := False; + If (VesaModeInfo.WinAAttributes And $01) <> 0 Then + Begin + If (VesaModeInfo.WinAAttributes And $02) <> 0 Then + hasReadWindow := True; + If (VesaModeInfo.WinAAttributes And $04) <> 0 Then + hasWriteWindow := True; + End; + If (VesaModeInfo.WinBAttributes And $01) <> 0 Then + Begin + If (VesaModeInfo.WinBAttributes And $02) <> 0 Then + hasReadWindow := True; + If (VesaModeInfo.WinBAttributes And $04) <> 0 Then + hasWriteWindow := True; + End; + If (Not hasReadWindow) Or (Not hasWriteWindow) Then + IsModeOk := False; + End; + If IsModeOk And ((ModeAttr = 2) Or (ModeAttr = 3)) Then + Begin {check lfb...} + {...} + End; + + If IsModeOk Then + Begin +// Write(HexStr(I, 4), ' '); + AddToList; + Inc(NrOfModes); + Last^.ModeInfo.ModeNumber := I; + Last^.ModeInfo.VesaModeInfo := VesaModeInfo; + End; + End; + End; + global_dos_free(AddrSel); + If ModeInfo <> Nil Then + FreeMem(ModeInfo); + If NrOfModes <> -1 Then + ModeInfo := GetMem((NrOfModes + 1) * SizeOf(TModeInfo)) + Else + ModeInfo := Nil; + Run := First; + For I := 0 To NrOfModes Do + Begin + ModeInfo[I] := Run^.ModeInfo; + Tmp := Run; + Run := Run^.Next; + Dispose(Tmp); + End; + {$IFDEF DEBUGOUTPUT} + Writeln; + {$ENDIF DEBUGOUTPUT} +End; + +Procedure GetVBEInfo; + +Var + Addr : DWord; + AddrSeg : Word; + AddrSel : Word; + tmp : DWord; + +Begin + Addr := global_dos_alloc(512); + AddrSeg := Addr Shr 16; + AddrSel := Addr And $FFFF; + VBEInfoBlock.VBESignature := $32454256; {'VBE2'} + dosmemput(AddrSeg, 0, VBEInfoBlock, 4); + RealRegs.ax := $4F00; + RealRegs.es := AddrSeg; + RealRegs.di := 0; + realintr($10, RealRegs); + VBEPresent := RealRegs.al = $4F; + If VBEPresent Then + Begin + dosmemget(AddrSeg, 0, VBEInfoBlock, SizeOf(VBEInfoBlock)); + {todo: check for 'VESA' id string} + VideoMemory := VBEInfoBlock.TotalMemory * 64; + EightBitDACSupported := (VBEInfoBlock.Capabilities And 1) <> 0; + nonVGA := (VBEInfoBlock.Capabilities And 2) <> 0; + SnowyRAMDAC := (VBEInfoBlock.Capabilities And 4) <> 0; + StereoSignalingSupport := (VBEInfoBlock.Capabilities And 8) <> 0; + StereoSignalingVesaEVC := (VBEInfoBlock.Capabilities And 16) <> 0; + OEMString := GetRMString(VBEInfoBlock.OemStringPtr); + If VBEInfoBlock.VBEVersion >= $0200 Then + Begin + OEMVendorName := GetRMString(VBEInfoBlock.OemVendorNamePtr); + OEMProductName := GetRMString(VBEInfoBlock.OemProductNamePtr); + OEMProductRev := GetRMString(VBEInfoBlock.OemProductRevPtr); + OEMSoftwareRev := VBEInfoBlock.OemSoftwareRev; + End + Else + Begin + OEMVendorName := ''; + OEMProductName := ''; + OEMProductRev := ''; + OEMSoftwareRev := -1; + End; + End; + global_dos_free(AddrSel); + + {$IFDEF DEBUGOUTPUT} + If VBEPresent Then + Begin + Writeln('VBEVersion: ', bcd(VBEInfoBlock.VBEVersion Shr 8), '.', bcd(VBEInfoBlock.VBEVersion And $FF)); + Writeln('VideoMemory: ', VideoMemory, ' KB'); + Writeln('EightBitDACSupported: ', EightBitDACSupported); + Writeln('nonVGA: ', nonVGA); + Writeln('SnowyRAMDAC: ', SnowyRAMDAC); + Writeln('StereoSignalingSupport: ', StereoSignalingSupport); + If StereoSignalingSupport Then + If StereoSignalingVesaEVC Then + Writeln('Stereo signaling supported via VESA EVC connector') + Else + Writeln('Stereo signaling supported via external VESA stereo connector'); + If OEMString <> '' Then + Writeln('OEMString: ', OEMString); + If OEMVendorName <> '' Then + Writeln('OEMVendorName: ', OEMVendorName); + If OEMProductName <> '' Then + Writeln('OEMProductName: ', OEMProductName); + If OEMProductRev <> '' Then + Writeln('OEMProductRev: ', OEMProductRev); + If OEMSoftwareRev <> -1 Then + Writeln('OEMSoftwareRev: ', bcd(OEMSoftwareRev Shr 8), '.', bcd(OEMSoftwareRev And $FF)); + Write('VideoModeList:'); + tmp := (VBEInfoBlock.VideoModePtr Shr 16) * 16 + (VBEInfoBlock.VideoModePtr And $FFFF); + While MemW[tmp] <> $FFFF Do + Begin + Write(' $', HexStr(MemW[tmp], 4)); + Inc(tmp, 2); + End; + Writeln; + Writeln; + End; + {$ENDIF DEBUGOUTPUT} +End; + +Function SetVESAMode(M : Integer) : Boolean; + +Var + ModeAttr : DWord; + lLFBUsed : Boolean; + lReadWindow, lWriteWindow : Integer; + lReadWindowStart, lWriteWindowStart : Integer; + lReadWindowAddress, lWriteWindowAddress : Integer; + lWindowGranularity : DWord; + lWindowSize, lWindowSizeG : DWord; + +Begin + SetVESAMode := False; + DisposeRealModePalette; + ModeAttr := (ModeInfo[M].VesaModeInfo.ModeAttributes And $C0) Shr 6; + Case ModeAttr Of + 0 : lLFBUsed := False; {windowed frame buffer only} + 2 : lLFBUsed := UseLFB; {both windowed and linear} + 3 : lLFBUsed := True; {linear frame buffer only} + End; + If Not lLFBUsed Then + Begin + With ModeInfo[M].VesaModeInfo Do + Begin + lReadWindow := -1; + lWriteWindow := -1; + If (WinAAttributes And $01) <> 0 Then + Begin + If (WinAAttributes And $02) <> 0 Then + lReadWindow := 0; + If (WinAAttributes And $04) <> 0 Then + lWriteWindow := 0; + End; + If (lReadWindow = -1) Or (lWriteWindow = -1) Then + If (WinBAttributes And $01) <> 0 Then + Begin + If (lReadWindow = -1) And ((WinBAttributes And $02) <> 0) Then + lReadWindow := 1; + If (lWriteWindow = -1) And ((WinBAttributes And $04) <> 0) Then + lWriteWindow := 1; + End; + Case lReadWindow Of + -1 : Exit{err}; + 0 : lReadWindowAddress := WinASegment Shl 4; + 1 : lReadWindowAddress := WinBSegment Shl 4; + End; + Case lWriteWindow Of + -1 : Exit{err}; + 0 : lWriteWindowAddress := WinASegment Shl 4; + 1 : lWriteWindowAddress := WinBSegment Shl 4; + End; + lWindowGranularity := WinGranularity * 1024; + lWindowSize := WinSize * 1024; + lWindowSizeG := lWindowSize Div lWindowGranularity; + lWindowSize := lWindowSizeG * lWindowGranularity; + End; + End + Else + Begin + {TODO: lfb} + End; + RealRegs.ax := $4F02; + If lLFBUsed Then + RealRegs.bx := ModeInfo[M].ModeNumber Or $4000 + Else + RealRegs.bx := ModeInfo[M].ModeNumber; + realintr($10, RealRegs); + PaletteDACbits := 6; + With ModeInfo[M].VesaModeInfo Do + Begin + If (BitsPerPixel = 8) And (MemoryModel = 4{packed pixel}) Then + Begin + SetPaletteHW := True; + If (VBEInfoBlock.VBEVersion >= $200) And + ((ModeAttributes And 32) <> 0) Then {if nonVGA, use func9 to set palette} + SetPaletteHW := False; + + If EightBitDACSupported Then + SwitchTo8bitDAC; + + If Not SetPaletteHW Then + AllocateRealModePalette; + End; + End; + + LFBUsed := lLFBUsed; + ReadWindow := lReadWindow; + WriteWindow := lWriteWindow; + ReadWindowStart := lReadWindowStart; + WriteWindowStart := lWriteWindowStart; + ReadWindowAddress := lReadWindowAddress; + WriteWindowAddress := lWriteWindowAddress; + WindowGranularity := lWindowGranularity; + WindowSize := lWindowSize; + WindowSizeG := lWindowSizeG; + + SetVESAMode := True; +End; + +Procedure RestoreTextMode; + +Begin + DisposeRealModePalette; + RealRegs.ax := $0003; + realintr($10, RealRegs); +End; + +Procedure InitVESA; + +Begin + If Not VESAInit Then + VESAInit := True + Else + Exit; + GetVBEInfo; + If VBEPresent Then + GetModes; +End; + +Initialization + VESAInit := False; + CurrentMode := -1; + UseLFB := {True}False; + ModeInfo := Nil; + RealModePaletteSel := 0; + RealModePaletteSeg := 0; + +Finalization + temp := ModeInfo; + ModeInfo := Nil; + If temp <> Nil Then + FreeMem(temp); + DisposeRealModePalette; + +End. diff --git a/packages/ptc/src/errord.inc b/packages/ptc/src/errord.inc new file mode 100644 index 0000000000..44e59fbf88 --- /dev/null +++ b/packages/ptc/src/errord.inc @@ -0,0 +1,35 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCError=Class(TObject) + Private + FMessage : String; + Public + Constructor Create; + Constructor Create(Const AMessage : String); + Constructor Create(Const AMessage : String; Const AError : TPTCError); + Constructor Create(Const AError : TPTCError); + Destructor Destroy; Override; + Procedure Assign(Const AError : TPTCError); + Function Equals(Const AError : TPTCError) : Boolean; + Procedure Report; + Property Message : String read FMessage; + End; diff --git a/packages/ptc/src/errori.inc b/packages/ptc/src/errori.inc new file mode 100644 index 0000000000..7d16c8136b --- /dev/null +++ b/packages/ptc/src/errori.inc @@ -0,0 +1,100 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCError.Create; + +Begin + FMessage := ''; +End; + +Constructor TPTCError.Create(Const AMessage : String); + +Begin + FMessage := AMessage; + LOG('error', Self); +End; + +Constructor TPTCError.Create(Const AMessage : String; Const AError : TPTCError); + +Begin + FMessage := AMessage + #10 + AError.FMessage; + LOG('composite error', Self); +End; + +Constructor TPTCError.Create(Const AError : TPTCError); + +Begin + FMessage := AError.FMessage; +End; + +Destructor TPTCError.Destroy; + +Begin + Inherited Destroy; +End; + +Procedure TPTCError.Assign(Const AError : TPTCError); + +Begin + FMessage := AError.FMessage; +End; + +Function TPTCError.Equals(Const AError : TPTCError) : Boolean; + +Begin + Equals := (FMessage = AError.FMessage); +End; + +Procedure TPTCError.Report; + +{$IFDEF Win32} +Var + txt : AnsiString; +{$ENDIF Win32} + +{$IFDEF WinCE} +Var + txt : WideString; +{$ENDIF WinCE} + +Begin + LOG('error report', Self); + {$IFDEF GO32V2} + RestoreTextMode; + Writeln(stderr, 'error: ', FMessage); + {$ENDIF GO32V2} + + {$IFDEF Win32} + Win32Cursor_resurrect; + txt := FMessage; + MessageBox(0, PChar(txt), 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST); + {$ENDIF Win32} + + {$IFDEF WinCE} + txt := FMessage; + MessageBox(0, PWideChar(txt), 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST); + {$ENDIF WinCE} + + {$IFDEF UNIX} + Writeln(stderr, 'error: ', FMessage); + {$ENDIF UNIX} + + Halt(1); +End; diff --git a/packages/ptc/src/eventd.inc b/packages/ptc/src/eventd.inc new file mode 100644 index 0000000000..1bd0103e4f --- /dev/null +++ b/packages/ptc/src/eventd.inc @@ -0,0 +1,38 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCEventType = (PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent}); + TPTCEventMask = Set Of TPTCEventType; + TPTCEvent = Class(TObject) + Protected + Function GetType : TPTCEventType; Virtual; Abstract; + Public + Property EventType : TPTCEventType Read GetType; + End; + +Const + PTCAnyEvent : TPTCEventMask = [PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent}]; + +{Type + TPTCExposeEvent = Class(TPTCEvent) + Protected + Function GetType : TPTCEventType; Override; + End;} diff --git a/packages/ptc/src/eventi.inc b/packages/ptc/src/eventi.inc new file mode 100644 index 0000000000..9c33b9e5bf --- /dev/null +++ b/packages/ptc/src/eventi.inc @@ -0,0 +1,141 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{Function TPTCExposeEvent.GetType : TPTCEventType; + +Begin + Result := PTCExposeEvent; +End;} + +Type + PEventLinkedList = ^TEventLinkedList; + TEventLinkedList = Record + Event : TPTCEvent; + Next : PEventLinkedList; + End; + TEventQueue = Class(TObject) + Private + FHead, FTail : PEventLinkedList; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure AddEvent(event : TPTCEvent); + Function PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent; + Function NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent; + End; + +Constructor TEventQueue.Create; + +Begin + FHead := Nil; + FTail := Nil; +End; + +Destructor TEventQueue.Destroy; + +Var + p, pnext : PEventLinkedList; + +Begin + p := FHead; + While p <> Nil Do + Begin + FreeAndNil(p^.Event); + pnext := p^.Next; + Dispose(p); + p := pnext; + End; + Inherited Destroy; +End; + +Procedure TEventQueue.AddEvent(event : TPTCEvent); + +Var + tmp : PEventLinkedList; + +Begin + New(tmp); + FillChar(tmp^, SizeOf(tmp^), 0); + tmp^.Next := Nil; + tmp^.Event := event; + + If FTail <> Nil Then + Begin + FTail^.Next := tmp; + FTail := tmp; + End + Else + Begin { FTail = Nil } + FHead := tmp; + FTail := tmp; + End; +End; + +Function TEventQueue.PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent; + +Var + p : PEventLinkedList; + +Begin + p := FHead; + While p <> Nil Do + Begin + If p^.Event.EventType In EventMask Then + Begin + Result := p^.Event; + Exit; + End; + p := p^.Next; + End; + + Result := Nil; +End; + +Function TEventQueue.NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent; + +Var + prev, p : PEventLinkedList; + +Begin + prev := Nil; + p := FHead; + While p <> Nil Do + Begin + If p^.Event.EventType In EventMask Then + Begin + Result := p^.Event; + + { delete the element from the linked list } + If prev <> Nil Then + prev^.Next := p^.Next + Else + FHead := p^.Next; + If p^.Next = Nil Then + FTail := prev; + Dispose(p); + + Exit; + End; + prev := p; + p := p^.Next; + End; + + Result := Nil; +End; diff --git a/packages/ptc/src/formatd.inc b/packages/ptc/src/formatd.inc new file mode 100644 index 0000000000..5dedf80b89 --- /dev/null +++ b/packages/ptc/src/formatd.inc @@ -0,0 +1,45 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCFormat=Class(TObject) + Private + FFormat : THermesFormat; + Function GetDirect : Boolean; + Function GetBytes : Integer; + Public + Constructor Create; + Constructor Create(ABits : Integer); + Constructor Create(ABits : Integer; + ARedMask, AGreenMask, ABlueMask : Uint32; + AAlphaMask : Uint32 = 0); + Constructor Create(Const format : TPTCFormat); + Destructor Destroy; Override; + Procedure Assign(Const format : TPTCFormat); + Function Equals(Const format : TPTCFormat) : Boolean; + Property R : Uint32 read FFormat.r; + Property G : Uint32 read FFormat.g; + Property B : Uint32 read FFormat.b; + Property A : Uint32 read FFormat.a; + Property Bits : Integer read FFormat.bits; + Property Indexed : Boolean read FFormat.indexed; + Property Direct : Boolean read GetDirect; + Property Bytes : Integer read GetBytes; + End; diff --git a/packages/ptc/src/formati.inc b/packages/ptc/src/formati.inc new file mode 100644 index 0000000000..eacf822742 --- /dev/null +++ b/packages/ptc/src/formati.inc @@ -0,0 +1,121 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCFormat.Create; + +Begin + { defaults } + FFormat.r := 0; + FFormat.g := 0; + FFormat.b := 0; + FFormat.a := 0; + FFormat.bits := 0; + FFormat.indexed := False; + + { initialize hermes } + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); +End; + +Constructor TPTCFormat.Create(ABits : Integer); + +Begin + { check bits per pixel } + If ABits <> 8 Then + Raise TPTCError.Create('unsupported bits per pixel'); + + { indexed color } + FFormat.r := 0; + FFormat.g := 0; + FFormat.b := 0; + FFormat.a := 0; + FFormat.bits := ABits; + FFormat.indexed := True; + + { initialize hermes } + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); +End; + +Constructor TPTCFormat.Create(ABits : Integer; + ARedMask, AGreenMask, ABlueMask : Uint32; + AAlphaMask : Uint32 = 0); + +Begin + { check bits per pixel } + If ((ABits And 7) <> 0) Or (ABits <= 0) Or (ABits > 32) Then + Raise TPTCError.Create('unsupported bits per pixel'); + + { direct color } + FFormat.r := ARedMask; + FFormat.g := AGreenMask; + FFormat.b := ABlueMask; + FFormat.a := AAlphaMask; + FFormat.bits := ABits; + FFormat.indexed := False; + + { initialize hermes } + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); +End; + +Constructor TPTCFormat.Create(Const format : TPTCFormat); + +Begin + { initialize hermes } + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + + Hermes_FormatCopy(@format.FFormat, @FFormat) +End; + +{$INFO TODO: check what happens if Hermes_Init blows up in the constructor...} +Destructor TPTCFormat.Destroy; + +Begin + Hermes_Done; + Inherited Destroy; +End; + +Procedure TPTCFormat.Assign(Const format : TPTCFormat); + +Begin + If Self = format Then + Exit; + Hermes_FormatCopy(@format.Fformat, @Fformat); +End; + +Function TPTCFormat.Equals(Const format : TPTCFormat) : Boolean; + +Begin + Result := Hermes_FormatEquals(@format.FFormat, @FFormat); +End; + +Function TPTCFormat.GetDirect : Boolean; + +Begin + Result := Not FFormat.indexed; +End; + +Function TPTCFormat.GetBytes : Integer; + +Begin + Result := FFormat.bits Shr 3; +End; diff --git a/packages/ptc/src/keyd.inc b/packages/ptc/src/keyd.inc new file mode 100644 index 0000000000..6ea2394b23 --- /dev/null +++ b/packages/ptc/src/keyd.inc @@ -0,0 +1,279 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCKeyEvent=Class(TPTCEvent) + Private + m_code : Integer; + m_unicode : Integer; + m_alt : Boolean; + m_shift : Boolean; + m_control : Boolean; + m_press : Boolean; + + Function GetRelease : Boolean; + Protected + Function GetType : TPTCEventType; Override; + Public + Constructor Create; + Constructor Create(_code : Integer); + Constructor Create(_code, _unicode : Integer); + Constructor Create(_code, _unicode : Integer; _press : Boolean); + Constructor Create(_code : Integer; _alt, _shift, _control : Boolean); + Constructor Create(_code : Integer; _alt, _shift, _control, _press : Boolean); + Constructor Create(_code, _unicode : Integer; + _alt, _shift, _control : Boolean); + Constructor Create(_code, _unicode : Integer; + _alt, _shift, _control, _press : Boolean); + Constructor Create(Const key : TPTCKeyEvent); + Destructor Destroy; Override; + Procedure Assign(Const key : TPTCKeyEvent); + Function Equals(Const key : TPTCKeyEvent) : Boolean; + Property code : Integer read m_code; + Property unicode : Integer read m_unicode; + Property alt : Boolean read m_alt; + Property shift : Boolean read m_shift; + Property control : Boolean read m_control; + Property press : Boolean read m_press; + Property release : Boolean read GetRelease; + End; + +Const + PTCKEY_UNDEFINED = $00; + PTCKEY_CANCEL = $03; + PTCKEY_BACKSPACE = $08; {'\b'} + PTCKEY_TAB = $09; {'\t'} + PTCKEY_ENTER = $0A; {'\n'} + PTCKEY_CLEAR = $0C; + PTCKEY_SHIFT = $10; + PTCKEY_CONTROL = $11; + PTCKEY_ALT = $12; + PTCKEY_PAUSE = $13; + PTCKEY_CAPSLOCK = $14; + PTCKEY_KANA = $15; + PTCKEY_FINAL = $18; + PTCKEY_KANJI = $19; + PTCKEY_ESCAPE = $1B; + PTCKEY_CONVERT = $1C; + PTCKEY_NONCONVERT = $1D; + PTCKEY_ACCEPT = $1E; + PTCKEY_MODECHANGE = $1F; + PTCKEY_SPACE = $20; + PTCKEY_PAGEUP = $21; + PTCKEY_PAGEDOWN = $22; + PTCKEY_END = $23; + PTCKEY_HOME = $24; + PTCKEY_LEFT = $25; + PTCKEY_UP = $26; + PTCKEY_RIGHT = $27; + PTCKEY_DOWN = $28; + PTCKEY_COMMA = $2C; {','} + PTCKEY_PERIOD = $2E; {'.'} + PTCKEY_SLASH = $2F; {'/'} + PTCKEY_ZERO = $30; + PTCKEY_ONE = $31; + PTCKEY_TWO = $32; + PTCKEY_THREE = $33; + PTCKEY_FOUR = $34; + PTCKEY_FIVE = $35; + PTCKEY_SIX = $36; + PTCKEY_SEVEN = $37; + PTCKEY_EIGHT = $38; + PTCKEY_NINE = $39; + PTCKEY_SEMICOLON = $3B; {';'} + PTCKEY_EQUALS = $3D; {'='} + PTCKEY_A = $41; + PTCKEY_B = $42; + PTCKEY_C = $43; + PTCKEY_D = $44; + PTCKEY_E = $45; + PTCKEY_F = $46; + PTCKEY_G = $47; + PTCKEY_H = $48; + PTCKEY_I = $49; + PTCKEY_J = $4A; + PTCKEY_K = $4B; + PTCKEY_L = $4C; + PTCKEY_M = $4D; + PTCKEY_N = $4E; + PTCKEY_O = $4F; + PTCKEY_P = $50; + PTCKEY_Q = $51; + PTCKEY_R = $52; + PTCKEY_S = $53; + PTCKEY_T = $54; + PTCKEY_U = $55; + PTCKEY_V = $56; + PTCKEY_W = $57; + PTCKEY_X = $58; + PTCKEY_Y = $59; + PTCKEY_Z = $5A; + PTCKEY_OPENBRACKET = $5B; {'['} + PTCKEY_BACKSLASH = $5C; {'\'} + PTCKEY_CLOSEBRACKET = $5D; {']'} + PTCKEY_NUMPAD0 = $60; + PTCKEY_NUMPAD1 = $61; + PTCKEY_NUMPAD2 = $62; + PTCKEY_NUMPAD3 = $63; + PTCKEY_NUMPAD4 = $64; + PTCKEY_NUMPAD5 = $65; + PTCKEY_NUMPAD6 = $66; + PTCKEY_NUMPAD7 = $67; + PTCKEY_NUMPAD8 = $68; + PTCKEY_NUMPAD9 = $69; + PTCKEY_MULTIPLY = $6A; {numpad '*'} + PTCKEY_ADD = $6B; {numpad '+'} + PTCKEY_SEPARATOR = $6C; + PTCKEY_SUBTRACT = $6D; {numpad '-'} + PTCKEY_DECIMAL = $6E; {numpad '.'} + PTCKEY_DIVIDE = $6F; {numpad '/'} + PTCKEY_F1 = $70; + PTCKEY_F2 = $71; + PTCKEY_F3 = $72; + PTCKEY_F4 = $73; + PTCKEY_F5 = $74; + PTCKEY_F6 = $75; + PTCKEY_F7 = $76; + PTCKEY_F8 = $77; + PTCKEY_F9 = $78; + PTCKEY_F10 = $79; + PTCKEY_F11 = $7A; + PTCKEY_F12 = $7B; + PTCKEY_DELETE = $7F; + PTCKEY_NUMLOCK = $90; + PTCKEY_SCROLLLOCK = $91; + PTCKEY_PRINTSCREEN = $9A; + PTCKEY_INSERT = $9B; + PTCKEY_HELP = $9C; + PTCKEY_META = $9D; + PTCKEY_BACKQUOTE = $C0; + PTCKEY_QUOTE = $DE; + +(* TPTCKeyCode = ( + PTCKEY_UNDEFINED := $00, + PTCKEY_CANCEL := $03, + PTCKEY_BACKSPACE := $08, {'\b'} + PTCKEY_TAB := $09, {'\t'} + PTCKEY_ENTER := $0A, {'\n'} + PTCKEY_CLEAR := $0C, + PTCKEY_SHIFT := $10, + PTCKEY_CONTROL := $11, + PTCKEY_ALT := $12, + PTCKEY_PAUSE := $13, + PTCKEY_CAPSLOCK := $14, + PTCKEY_KANA := $15, + PTCKEY_FINAL := $18, + PTCKEY_KANJI := $19, + PTCKEY_ESCAPE := $1B, + PTCKEY_CONVERT := $1C, + PTCKEY_NONCONVERT := $1D, + PTCKEY_ACCEPT := $1E, + PTCKEY_MODECHANGE := $1F, + PTCKEY_SPACE := $20, + PTCKEY_PAGEUP := $21, + PTCKEY_PAGEDOWN := $22, + PTCKEY_END := $23, + PTCKEY_HOME := $24, + PTCKEY_LEFT := $25, + PTCKEY_UP := $26, + PTCKEY_RIGHT := $27, + PTCKEY_DOWN := $28, + PTCKEY_COMMA := $2C, {','} + PTCKEY_PERIOD := $2E, {'.'} + PTCKEY_SLASH := $2F, {'/'} + PTCKEY_ZERO := $30, + PTCKEY_ONE := $31, + PTCKEY_TWO := $32, + PTCKEY_THREE := $33, + PTCKEY_FOUR := $34, + PTCKEY_FIVE := $35, + PTCKEY_SIX := $36, + PTCKEY_SEVEN := $37, + PTCKEY_EIGHT := $38, + PTCKEY_NINE := $39, + PTCKEY_SEMICOLON := $3B, {';'} + PTCKEY_EQUALS := $3D, {'='} + PTCKEY_A := $41, + PTCKEY_B := $42, + PTCKEY_C := $43, + PTCKEY_D := $44, + PTCKEY_E := $45, + PTCKEY_F := $46, + PTCKEY_G := $47, + PTCKEY_H := $48, + PTCKEY_I := $49, + PTCKEY_J := $4A, + PTCKEY_K := $4B, + PTCKEY_L := $4C, + PTCKEY_M := $4D, + PTCKEY_N := $4E, + PTCKEY_O := $4F, + PTCKEY_P := $50, + PTCKEY_Q := $51, + PTCKEY_R := $52, + PTCKEY_S := $53, + PTCKEY_T := $54, + PTCKEY_U := $55, + PTCKEY_V := $56, + PTCKEY_W := $57, + PTCKEY_X := $58, + PTCKEY_Y := $59, + PTCKEY_Z := $5A, + PTCKEY_OPENBRACKET := $5B, {'['} + PTCKEY_BACKSLASH := $5C, {'\'} + PTCKEY_CLOSEBRACKET := $5D, {']'} + PTCKEY_NUMPAD0 := $60, + PTCKEY_NUMPAD1 := $61, + PTCKEY_NUMPAD2 := $62, + PTCKEY_NUMPAD3 := $63, + PTCKEY_NUMPAD4 := $64, + PTCKEY_NUMPAD5 := $65, + PTCKEY_NUMPAD6 := $66, + PTCKEY_NUMPAD7 := $67, + PTCKEY_NUMPAD8 := $68, + PTCKEY_NUMPAD9 := $69, + PTCKEY_MULTIPLY := $6A, {numpad '*'} + PTCKEY_ADD := $6B, {numpad '+'} + PTCKEY_SEPARATOR := $6C, + PTCKEY_SUBTRACT := $6D, {numpad '-'} + PTCKEY_DECIMAL := $6E, {numpad '.'} + PTCKEY_DIVIDE := $6F, {numpad '/'} + PTCKEY_F1 := $70, + PTCKEY_F2 := $71, + PTCKEY_F3 := $72, + PTCKEY_F4 := $73, + PTCKEY_F5 := $74, + PTCKEY_F6 := $75, + PTCKEY_F7 := $76, + PTCKEY_F8 := $77, + PTCKEY_F9 := $78, + PTCKEY_F10 := $79, + PTCKEY_F11 := $7A, + PTCKEY_F12 := $7B, + PTCKEY_DELETE := $7F, + PTCKEY_NUMLOCK := $90, + PTCKEY_SCROLLLOCK := $91, + PTCKEY_PRINTSCREEN := $9A, + PTCKEY_INSERT := $9B, + PTCKEY_HELP := $9C, + PTCKEY_META := $9D, + PTCKEY_BACKQUOTE := $C0, + PTCKEY_QUOTE := $DE + );*) diff --git a/packages/ptc/src/keyeventd.inc b/packages/ptc/src/keyeventd.inc new file mode 100644 index 0000000000..07bf83e672 --- /dev/null +++ b/packages/ptc/src/keyeventd.inc @@ -0,0 +1,166 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCKeyEvent=Class(TPTCEvent) + Private + FCode : Integer; + FUnicode : Integer; + FAlt : Boolean; + FShift : Boolean; + FControl : Boolean; + FPress : Boolean; + + Function GetRelease : Boolean; + Protected + Function GetType : TPTCEventType; Override; + Public + Constructor Create; + Constructor Create(ACode : Integer); + Constructor Create(ACode, AUnicode : Integer); + Constructor Create(ACode, AUnicode : Integer; APress : Boolean); + Constructor Create(ACode : Integer; AAlt, AShift, AControl : Boolean); + Constructor Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean); + Constructor Create(ACode, AUnicode : Integer; + AAlt, AShift, AControl : Boolean); + Constructor Create(ACode, AUnicode : Integer; + AAlt, AShift, AControl, APress : Boolean); + Constructor Create(Const AKey : TPTCKeyEvent); + Procedure Assign(Const AKey : TPTCKeyEvent); + Function Equals(Const AKey : TPTCKeyEvent) : Boolean; + Property Code : Integer read FCode; + Property Unicode : Integer read FUnicode; + Property Alt : Boolean read FAlt; + Property Shift : Boolean read FShift; + Property Control : Boolean read FControl; + Property Press : Boolean read FPress; + Property Release : Boolean read GetRelease; + End; + +Const + PTCKEY_UNDEFINED = $00; + PTCKEY_CANCEL = $03; + PTCKEY_BACKSPACE = $08; {'\b'} + PTCKEY_TAB = $09; {'\t'} + PTCKEY_ENTER = $0A; {'\n'} + PTCKEY_CLEAR = $0C; + PTCKEY_SHIFT = $10; + PTCKEY_CONTROL = $11; + PTCKEY_ALT = $12; + PTCKEY_PAUSE = $13; + PTCKEY_CAPSLOCK = $14; + PTCKEY_KANA = $15; + PTCKEY_FINAL = $18; + PTCKEY_KANJI = $19; + PTCKEY_ESCAPE = $1B; + PTCKEY_CONVERT = $1C; + PTCKEY_NONCONVERT = $1D; + PTCKEY_ACCEPT = $1E; + PTCKEY_MODECHANGE = $1F; + PTCKEY_SPACE = $20; + PTCKEY_PAGEUP = $21; + PTCKEY_PAGEDOWN = $22; + PTCKEY_END = $23; + PTCKEY_HOME = $24; + PTCKEY_LEFT = $25; + PTCKEY_UP = $26; + PTCKEY_RIGHT = $27; + PTCKEY_DOWN = $28; + PTCKEY_COMMA = $2C; {','} + PTCKEY_PERIOD = $2E; {'.'} + PTCKEY_SLASH = $2F; {'/'} + PTCKEY_ZERO = $30; + PTCKEY_ONE = $31; + PTCKEY_TWO = $32; + PTCKEY_THREE = $33; + PTCKEY_FOUR = $34; + PTCKEY_FIVE = $35; + PTCKEY_SIX = $36; + PTCKEY_SEVEN = $37; + PTCKEY_EIGHT = $38; + PTCKEY_NINE = $39; + PTCKEY_SEMICOLON = $3B; {';'} + PTCKEY_EQUALS = $3D; {'='} + PTCKEY_A = $41; + PTCKEY_B = $42; + PTCKEY_C = $43; + PTCKEY_D = $44; + PTCKEY_E = $45; + PTCKEY_F = $46; + PTCKEY_G = $47; + PTCKEY_H = $48; + PTCKEY_I = $49; + PTCKEY_J = $4A; + PTCKEY_K = $4B; + PTCKEY_L = $4C; + PTCKEY_M = $4D; + PTCKEY_N = $4E; + PTCKEY_O = $4F; + PTCKEY_P = $50; + PTCKEY_Q = $51; + PTCKEY_R = $52; + PTCKEY_S = $53; + PTCKEY_T = $54; + PTCKEY_U = $55; + PTCKEY_V = $56; + PTCKEY_W = $57; + PTCKEY_X = $58; + PTCKEY_Y = $59; + PTCKEY_Z = $5A; + PTCKEY_OPENBRACKET = $5B; {'['} + PTCKEY_BACKSLASH = $5C; {'\'} + PTCKEY_CLOSEBRACKET = $5D; {']'} + PTCKEY_NUMPAD0 = $60; + PTCKEY_NUMPAD1 = $61; + PTCKEY_NUMPAD2 = $62; + PTCKEY_NUMPAD3 = $63; + PTCKEY_NUMPAD4 = $64; + PTCKEY_NUMPAD5 = $65; + PTCKEY_NUMPAD6 = $66; + PTCKEY_NUMPAD7 = $67; + PTCKEY_NUMPAD8 = $68; + PTCKEY_NUMPAD9 = $69; + PTCKEY_MULTIPLY = $6A; {numpad '*'} + PTCKEY_ADD = $6B; {numpad '+'} + PTCKEY_SEPARATOR = $6C; + PTCKEY_SUBTRACT = $6D; {numpad '-'} + PTCKEY_DECIMAL = $6E; {numpad '.'} + PTCKEY_DIVIDE = $6F; {numpad '/'} + PTCKEY_F1 = $70; + PTCKEY_F2 = $71; + PTCKEY_F3 = $72; + PTCKEY_F4 = $73; + PTCKEY_F5 = $74; + PTCKEY_F6 = $75; + PTCKEY_F7 = $76; + PTCKEY_F8 = $77; + PTCKEY_F9 = $78; + PTCKEY_F10 = $79; + PTCKEY_F11 = $7A; + PTCKEY_F12 = $7B; + PTCKEY_DELETE = $7F; + PTCKEY_NUMLOCK = $90; + PTCKEY_SCROLLLOCK = $91; + PTCKEY_PRINTSCREEN = $9A; + PTCKEY_INSERT = $9B; + PTCKEY_HELP = $9C; + PTCKEY_META = $9D; + PTCKEY_BACKQUOTE = $C0; + PTCKEY_QUOTE = $DE; diff --git a/packages/ptc/src/keyeventi.inc b/packages/ptc/src/keyeventi.inc new file mode 100644 index 0000000000..584886f5e3 --- /dev/null +++ b/packages/ptc/src/keyeventi.inc @@ -0,0 +1,153 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Function TPTCKeyEvent.GetType : TPTCEventType; + +Begin + Result := PTCKeyEvent; +End; + +Constructor TPTCKeyEvent.Create; + +Begin + FCode := Integer(PTCKEY_UNDEFINED); + FUnicode := -1; + FAlt := False; + FShift := False; + FControl := False; + FPress := True; +End; + +Constructor TPTCKeyEvent.Create(ACode : Integer); + +Begin + FCode := ACode; + FUnicode := -1; + FAlt := False; + FShift := False; + FControl := False; + FPress := True; +End; + +Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer); + +Begin + FCode := ACode; + FUnicode := AUnicode; + FAlt := False; + FShift := False; + FControl := False; + FPress := True; +End; + +Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; APress : Boolean); + +Begin + FCode := ACode; + FUnicode := AUnicode; + FAlt := False; + FShift := False; + FControl := False; + FPress := APress; +End; + +Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl : Boolean); + +Begin + FCode := ACode; + FUnicode := -1; + FAlt := AAlt; + FShift := AShift; + FControl := AControl; + FPress := True; +End; + +Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean); + +Begin + FCode := ACode; + FUnicode := -1; + FAlt := AAlt; + FShift := AShift; + FControl := AControl; + FPress := APress; +End; + +Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; AAlt, AShift, AControl : Boolean); + +Begin + FCode := ACode; + FUnicode := AUnicode; + FAlt := AAlt; + FShift := AShift; + FControl := AControl; + FPress := True; +End; + +Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; + AAlt, AShift, AControl, APress : Boolean); + +Begin + FCode := ACode; + FUnicode := AUnicode; + FAlt := AAlt; + FShift := AShift; + FControl := AControl; + FPress := APress; +End; + +Constructor TPTCKeyEvent.Create(Const AKey : TPTCKeyEvent); + +Begin + FCode := AKey.Code; + FUnicode := AKey.Unicode; + FAlt := AKey.Alt; + FShift := AKey.Shift; + FControl := AKey.Control; + FPress := AKey.Press; +End; + +Procedure TPTCKeyEvent.Assign(Const AKey : TPTCKeyEvent); + +Begin + FCode := AKey.Code; + FUnicode := AKey.Unicode; + FAlt := AKey.Alt; + FShift := AKey.Shift; + FControl := AKey.Control; + FPress := AKey.Press; +End; + +Function TPTCKeyEvent.Equals(Const AKey : TPTCKeyEvent) : Boolean; + +Begin + Result := (FCode = AKey.FCode) And + (FUnicode = AKey.FUnicode) And + (FAlt = AKey.FAlt) And + (FShift = AKey.FShift) And + (FControl = AKey.FControl) And + (FPress = AKey.FPress); +End; + +Function TPTCKeyEvent.GetRelease : Boolean; + +Begin + Result := Not FPress; +End; diff --git a/packages/ptc/src/keyi.inc b/packages/ptc/src/keyi.inc new file mode 100644 index 0000000000..df2cdc86cf --- /dev/null +++ b/packages/ptc/src/keyi.inc @@ -0,0 +1,154 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Function TPTCKeyEvent.GetType : TPTCEventType; + +Begin + Result := PTCKeyEvent; +End; + +Constructor TPTCKeyEvent.Create; + +Begin + m_code := Integer(PTCKEY_UNDEFINED); + m_unicode := -1; + m_alt := False; + m_shift := False; + m_control := False; + m_press := True; +End; + +Constructor TPTCKeyEvent.Create(_code : Integer); + +Begin + m_code := _code; + m_unicode := -1; + m_alt := False; + m_shift := False; + m_control := False; + m_press := True; +End; + +Constructor TPTCKeyEvent.Create(_code, _unicode : Integer); + +Begin + m_code := _code; + m_unicode := _unicode; + m_alt := False; + m_shift := False; + m_control := False; + m_press := True; +End; + +Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _press : Boolean); + +Begin + m_code := _code; + m_unicode := _unicode; + m_alt := False; + m_shift := False; + m_control := False; + m_press := _press; +End; + +Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control : Boolean); + +Begin + m_code := _code; + m_unicode := -1; + m_alt := _alt; + m_shift := _shift; + m_control := _control; + m_press := True; +End; + +Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control, _press : Boolean); + +Begin + m_code := _code; + m_unicode := -1; + m_alt := _alt; + m_shift := _shift; + m_control := _control; + m_press := _press; +End; + +Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _alt, _shift, _control : Boolean); + +Begin + m_code := _code; + m_unicode := _unicode; + m_alt := _alt; + m_shift := _shift; + m_control := _control; + m_press := True; +End; + +Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; + _alt, _shift, _control, _press : Boolean); + +Begin + m_code := _code; + m_unicode := _unicode; + m_alt := _alt; + m_shift := _shift; + m_control := _control; + m_press := _press; +End; + +Constructor TPTCKeyEvent.Create(Const key : TPTCKeyEvent); + +Begin + ASSign(key); +End; + +Destructor TPTCKeyEvent.Destroy; + +Begin + Inherited Destroy; +End; + +Procedure TPTCKeyEvent.Assign(Const key : TPTCKeyEvent); + +Begin + If Self = key Then + Raise TPTCError.Create('self assignment is not allowed'); + + m_code := key.code; + m_unicode := key.unicode; + m_alt := key.alt; + m_shift := key.shift; + m_control := key.control; + m_press := key.press; +End; + +Function TPTCKeyEvent.Equals(Const key : TPTCKeyEvent) : Boolean; + +Begin + Equals := (m_code = key.m_code) And (m_unicode = key.m_unicode) And + (m_alt = key.m_alt) And (m_shift = key.m_shift) And + (m_control = key.m_control) And (m_press = key.m_press); +End; + +Function TPTCKeyEvent.GetRelease : Boolean; + +Begin + GetRelease := Not m_press; +End; diff --git a/packages/ptc/src/log.inc b/packages/ptc/src/log.inc new file mode 100644 index 0000000000..83b616aa9f --- /dev/null +++ b/packages/ptc/src/log.inc @@ -0,0 +1,209 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{$IFNDEF WinCE} +Const + LOG_filename = 'ptcpas.log'; +{$ELSE WinCE} +Function LOG_filename : WideString; + +Var + RequiredBufferLength : DWord; + ReturnedPathLength : DWord; + TempPathBuf : PWideChar; + dummy : Byte; + +Begin + RequiredBufferLength := GetTempPathW(0, @dummy); + TempPathBuf := GetMem(RequiredBufferLength * SizeOf(WideChar)); + Try + ReturnedPathLength := GetTempPathW(RequiredBufferLength, TempPathBuf); + + If ReturnedPathLength > RequiredBufferLength Then + Begin + { The temp path length increased between 2 consecutive calls to GetTempPath?! } + Result := ''; + Exit; + End; + + Result := TempPathBuf; + Result := Result + 'ptcpas.log'; + Finally + FreeMem(TempPathBuf); + End; +End; +{$ENDIF WinCE} + +Var + LOG_create : Boolean = True; + LOG_enabled : Boolean = + {$IFDEF DEBUG} + True; + {$ELSE DEBUG} + False; + {$ENDIF DEBUG} + LOG_file : Text; + +Procedure LOG_open; + +Begin + AssignFile(LOG_file, LOG_filename); + If LOG_create Then + Begin + Rewrite(LOG_file); + Writeln(LOG_file, '[log start]'); + LOG_create := False; + End + Else + Append(LOG_file); +End; + +Procedure LOG_close; + +Begin + CloseFile(LOG_file); +End; + +Procedure LOG(Const message : String); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message); + LOG_close; +End; + +Procedure LOG(Const message : String; data : Boolean); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Write(LOG_file, message, ' = '); + If data Then + Writeln(LOG_file, 'true') + Else + Writeln(LOG_file, 'false'); + LOG_close; +End; + +Procedure LOG(Const message : String; data : Integer); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : DWord); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : Int64); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : QWord); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : Single); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : Double); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; Const data : String); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ' = ', data); + LOG_close; +End; + +Procedure LOG(Const message : String; data : TPTCFormat); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Write(LOG_file, message, ' = Format('); + If data = Nil Then + Write(LOG_file, 'NIL') + Else + Begin + Write(LOG_file, data.bits:2); + If data.direct Then + Begin + Write(LOG_file, ',$', HexStr(data.r, 8), ',$', HexStr(data.g, 8), ',$', HexStr(data.b, 8)); + If data.a <> 0 Then + Write(LOG_file, ',$', HexStr(data.a, 8)); + End; + End; + Writeln(LOG_file, ')'); + LOG_close; +End; + +Procedure LOG(Const message : String; data : TPTCError); + +Begin + If Not LOG_enabled Then + Exit; + LOG_open; + Writeln(LOG_file, message, ': ', data.message); + LOG_close; +End; diff --git a/packages/ptc/src/moded.inc b/packages/ptc/src/moded.inc new file mode 100644 index 0000000000..3c4a8841f8 --- /dev/null +++ b/packages/ptc/src/moded.inc @@ -0,0 +1,40 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + PPTCMode=^TPTCMode; + TPTCMode=Class(TObject) + Private + FValid : Boolean; + FWidth : Integer; + FHeight : Integer; + FFormat : TPTCFormat; + Public + Constructor Create; + Constructor Create(AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + Constructor Create(Const mode : TPTCMode); + Destructor Destroy; Override; + Procedure Assign(Const mode : TPTCMode); + Function Equals(Const mode : TPTCMode) : Boolean; + Property Valid : Boolean read FValid; + Property Width : Integer read FWidth; + Property Height : Integer read FHeight; + Property Format : TPTCFormat read FFormat; + End; diff --git a/packages/ptc/src/modei.inc b/packages/ptc/src/modei.inc new file mode 100644 index 0000000000..8a0fd825ac --- /dev/null +++ b/packages/ptc/src/modei.inc @@ -0,0 +1,74 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCModeDynArray = Array Of TPTCMode; + +Constructor TPTCMode.Create; + +Begin + FFormat := TPTCFormat.Create; + FWidth := 0; + FHeight := 0; + FValid := False; +End; + +Constructor TPTCMode.Create(AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + +Begin + FFormat := TPTCFormat.Create(AFormat); + FWidth := AWidth; + FHeight := AHeight; + FValid := True; +End; + +Constructor TPTCMode.Create(Const mode : TPTCMode); + +Begin + FFormat := TPTCFormat.Create(mode.FFormat); + FWidth := mode.FWidth; + FHeight := mode.FHeight; + FValid := mode.FValid; +End; + +Destructor TPTCMode.Destroy; + +Begin + FFormat.Free; + Inherited Destroy; +End; + +Procedure TPTCMode.Assign(Const mode : TPTCMode); + +Begin + FFormat.Assign(mode.FFormat); + FWidth := mode.FWidth; + FHeight := mode.FHeight; + FValid := mode.FValid; +End; + +Function TPTCMode.Equals(Const mode : TPTCMode) : Boolean; + +Begin + Result := (FValid = mode.FValid) And + (FWidth = mode.FWidth) And + (FHeight = mode.FHeight) And + FFormat.Equals(mode.FFormat); +End; diff --git a/packages/ptc/src/mouseeventd.inc b/packages/ptc/src/mouseeventd.inc new file mode 100644 index 0000000000..f5495fcb1f --- /dev/null +++ b/packages/ptc/src/mouseeventd.inc @@ -0,0 +1,56 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type +{todo TPTCMouseCursor = (PTCMouseCursorDefault, + PTCMouseCursorAlwaysVisible, + PTCMouseCursorAlwaysInvisible);} + TPTCMouseButton = (PTCMouseButton1, { left mouse button } + PTCMouseButton2, { right mouse button } + PTCMouseButton3, { middle mouse button } + PTCMouseButton4, + PTCMouseButton5); + TPTCMouseButtonState = Set Of TPTCMouseButton; + TPTCMouseEvent = Class(TPTCEvent) + Private + FX, FY : Integer; + FDeltaX, FDeltaY : Integer; + FButtonState : TPTCMouseButtonState; + Protected + Function GetType : TPTCEventType; Override; + Public + Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState); + Property X : Integer Read FX; + Property Y : Integer Read FY; + Property DeltaX : Integer Read FDeltaX; + Property DeltaY : Integer Read FDeltaY; + Property ButtonState : TPTCMouseButtonState Read FButtonState; + End; + TPTCMouseButtonEvent = Class(TPTCMouseEvent) + Private + FPress : Boolean; + FButton : TPTCMouseButton; + Function GetRelease : Boolean; + Public + Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton); + Property Press : Boolean Read FPress; + Property Release : Boolean Read GetRelease; + Property Button : TPTCMouseButton Read FButton; + End; diff --git a/packages/ptc/src/mouseeventi.inc b/packages/ptc/src/mouseeventi.inc new file mode 100644 index 0000000000..15a1f269df --- /dev/null +++ b/packages/ptc/src/mouseeventi.inc @@ -0,0 +1,53 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Function TPTCMouseEvent.GetType : TPTCEventType; + +Begin + Result := PTCMouseEvent; +End; + +Constructor TPTCMouseEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState); + +Begin + FX := AX; + FY := AY; + FDeltaX := ADeltaX; + FDeltaY := ADeltaY; + FButtonState := AButtonState; +End; + +Constructor TPTCMouseButtonEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton); + +Begin + If APress Xor (AButton In AButtonState) Then + Raise TPTCError.Create('Invalid ButtonState'); + + Inherited Create(AX, AY, ADeltaX, ADeltaY, AButtonState); + + FPress := APress; + FButton := AButton; +End; + +Function TPTCMouseButtonEvent.GetRelease : Boolean; + +Begin + Result := Not FPress; +End; diff --git a/packages/ptc/src/paletted.inc b/packages/ptc/src/paletted.inc new file mode 100644 index 0000000000..d5e4fc2dac --- /dev/null +++ b/packages/ptc/src/paletted.inc @@ -0,0 +1,40 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCPalette=Class(TObject) + Private + m_locked : Boolean; + m_handle : THermesHandle; + Public + Constructor Create; + Constructor Create(Const _data : Array Of Uint32); + Constructor Create(Const palette : TPTCPalette); + Destructor Destroy; Override; + Procedure Assign(Const palette : TPTCPalette); + Function Equals(Const palette : TPTCPalette) : Boolean; + Function lock : PUint32; + Procedure unlock; + Procedure load(Const _data : Array Of Uint32); + Procedure load(_data : Pointer); + Procedure save(Var _data : Array Of Uint32); + Procedure save(_data : Pointer); + Function data : PUint32; + End; diff --git a/packages/ptc/src/palettei.inc b/packages/ptc/src/palettei.inc new file mode 100644 index 0000000000..3ae557088d --- /dev/null +++ b/packages/ptc/src/palettei.inc @@ -0,0 +1,130 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCPalette.Create; + +Var + zero : Array[0..255] Of Uint32; + +Begin + m_locked := False; + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + m_handle := Hermes_PaletteInstance; + If m_handle = 0 Then + Raise TPTCError.Create('could not create hermes palette instance'); + FillChar(zero, SizeOf(zero), 0); + load(zero); +End; + +Constructor TPTCPalette.Create(Const _data : Array Of Uint32); + +Begin + m_locked := False; + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + m_handle := Hermes_PaletteInstance; + If m_handle = 0 Then + Raise TPTCError.Create('could not create hermes palette instance'); + load(_data); +End; + +Constructor TPTCPalette.Create(Const palette : TPTCPalette); + +Begin + m_locked := False; + If Not Hermes_Init Then + Raise TPTCError.Create('could not initialize hermes'); + m_handle := Hermes_PaletteInstance; + If m_handle = 0 Then + Raise TPTCError.Create('could not create hermes palette instance'); + Assign(palette); +End; + +Destructor TPTCPalette.Destroy; + +Begin + If m_locked Then + Raise TPTCError.Create('palette is still locked'); + Hermes_PaletteReturn(m_handle); + Hermes_Done; + Inherited Destroy; +End; + +Procedure TPTCPalette.Assign(Const palette : TPTCPalette); + +Begin + If Self = palette Then + Raise TPTCError.Create('self assignment is not allowed'); + Hermes_PaletteSet(m_handle, Hermes_PaletteGet(palette.m_handle)); +End; + +Function TPTCPalette.Equals(Const palette : TPTCPalette) : Boolean; + +Begin + Equals := CompareDWord(Hermes_PaletteGet(m_handle)^, Hermes_PaletteGet(palette.m_handle)^, 1024 Div 4) = 0; +End; + +Function TPTCPalette.lock : PUint32; + +Begin + If m_locked Then + Raise TPTCError.Create('palette is already locked'); + m_locked := True; + lock := Hermes_PaletteGet(m_handle); +End; + +Procedure TPTCPalette.unlock; + +Begin + If Not m_locked Then + Raise TPTCError.Create('palette is not locked'); + m_locked := False; +End; + +Procedure TPTCPalette.load(Const _data : Array Of Uint32); + +Begin + Hermes_PaletteSet(m_handle, @_data); +End; + +Procedure TPTCPalette.load(_data : Pointer); + +Begin + Hermes_PaletteSet(m_handle, _data); +End; + +Procedure TPTCPalette.save(Var _data : Array Of Uint32); + +Begin + Move(Hermes_PaletteGet(m_handle)^, _data, 1024); +End; + +Procedure TPTCPalette.save(_data : Pointer); + +Begin + Move(Hermes_PaletteGet(m_handle)^, _data^, 1024); +End; + +Function TPTCPalette.data : PUint32; + +Begin + data := Hermes_PaletteGet(m_handle); +End; diff --git a/packages/ptc/src/ptc.pp b/packages/ptc/src/ptc.pp new file mode 100644 index 0000000000..bbc8b488ce --- /dev/null +++ b/packages/ptc/src/ptc.pp @@ -0,0 +1,262 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{$MODE objfpc} +{$MACRO ON} +{$UNDEF ENABLE_C_API} + +{$H+} + +{$IFDEF UNIX} + + { X11 extensions we want to enable at compile time } + {$INCLUDE x11/extensions.inc} + + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + {$DEFINE ENABLE_X11_EXTENSION_XF86DGA} + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + {$DEFINE ENABLE_X11_EXTENSION_XF86DGA} + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} + +{$ENDIF UNIX} + +Unit ptc; + +Interface + +{$IFNDEF FPDOC} +Uses + Hermes; +{$ENDIF FPDOC} + +Const + PTCPAS_VERSION = 'PTCPas 0.99.7'; + +Type + PUint8 = ^Uint8; + PUint16 = ^Uint16; + PUint32 = ^Uint32; + PUint64 = ^Uint64; + PSint8 = ^Sint8; + PSint16 = ^Sint16; + PSint32 = ^Sint32; + PSint64 = ^Sint64; + Uint8 = Byte; + Uint16 = Word; + Uint32 = DWord; + Uint64 = QWord; + Sint8 = ShortInt; + Sint16 = SmallInt; + Sint32 = LongInt; + Sint64 = Int64; + +{$INCLUDE coreinterface.inc} + +{$IFNDEF FPDOC} + +{$IFDEF ENABLE_C_API} +{$INCLUDE c_api/index.pp} +{$INCLUDE c_api/errord.pp} +{$INCLUDE c_api/exceptd.pp} +{$INCLUDE c_api/aread.pp} +{$INCLUDE c_api/colord.pp} +{$INCLUDE c_api/cleard.pp} +{$INCLUDE c_api/clipperd.pp} +{$INCLUDE c_api/copyd.pp} +{$INCLUDE c_api/keyd.pp} +{$INCLUDE c_api/formatd.pp} +{$INCLUDE c_api/paletted.pp} +{$INCLUDE c_api/surfaced.pp} +{$INCLUDE c_api/consoled.pp} +{$INCLUDE c_api/moded.pp} +{$INCLUDE c_api/timerd.pp} +{$ENDIF ENABLE_C_API} + +{$ENDIF FPDOC} + +Implementation + +{$IFDEF GO32V2} +Uses + textfx2, vesa, vga, cga, timeunit, crt, go32, mouse33h; +{$ENDIF GO32V2} + +{$IFDEF Win32} +Uses + Windows, p_ddraw; +{$ENDIF Win32} + +{$IFDEF WinCE} +Uses + Windows, p_gx; +{$ENDIF WinCE} + +{$IFDEF UNIX} +Uses + BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym + {$IFDEF ENABLE_X11_EXTENSION_XRANDR} + , xrandr + {$ENDIF ENABLE_X11_EXTENSION_XRANDR} + {$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} + , xf86vmode + {$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA} + , xf86dga + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA} + {$IFDEF ENABLE_X11_EXTENSION_XSHM} + , xshm, ipc + {$ENDIF ENABLE_X11_EXTENSION_XSHM} + ; +{$ENDIF UNIX} + +{ this little procedure is not a good reason to include the whole sysutils + unit :) } +Procedure FreeAndNil(Var q); + +Var + tmp : TObject; + +Begin + tmp := TObject(q); + Pointer(q) := Nil; + tmp.Free; +End; + +Procedure FreeMemAndNil(Var q); + +Var + tmp : Pointer; + +Begin + tmp := Pointer(q); + Pointer(q) := Nil; + If tmp <> Nil Then + FreeMem(tmp); +End; + +Function IntToStr(Value : Integer) : String; + +Begin + System.Str(Value, Result); +End; + +Function IntToStr(Value : Int64) : String; + +Begin + System.Str(Value, Result); +End; + +Function IntToStr(Value : QWord) : String; +Begin + System.Str(Value, Result); +End; + +{$INCLUDE log.inc} + +{$IFDEF WIN32} +{$INCLUDE win32/base/cursor.inc} +{$ENDIF WIN32} + +{$INCLUDE coreimplementation.inc} + +{$IFDEF GO32V2} +{$INCLUDE dos/includes.inc} +{$ENDIF GO32V2} + +{$IFDEF Win32} +{$INCLUDE win32/base/monitord.inc} +{$INCLUDE win32/base/eventd.inc} +{$INCLUDE win32/base/windowd.inc} +{$INCLUDE win32/base/hookd.inc} +{$INCLUDE win32/base/kbdd.inc} +{$INCLUDE win32/base/moused.inc} +{$INCLUDE win32/directx/hookd.inc} +{$INCLUDE win32/directx/libraryd.inc} +{$INCLUDE win32/directx/displayd.inc} +{$INCLUDE win32/directx/primaryd.inc} +{$INCLUDE win32/directx/directxconsoled.inc} +{$INCLUDE win32/gdi/win32dibd.inc} +{$INCLUDE win32/gdi/gdiconsoled.inc} + +{$INCLUDE win32/base/monitor.inc} +{$INCLUDE win32/base/event.inc} +{$INCLUDE win32/base/window.inc} +{$INCLUDE win32/base/hook.inc} +{$INCLUDE win32/base/kbd.inc} +{$INCLUDE win32/base/mousei.inc} +{$INCLUDE win32/directx/check.inc} +{$INCLUDE win32/directx/translate.inc} +{$INCLUDE win32/directx/hook.inc} +{$INCLUDE win32/directx/library.inc} +{$INCLUDE win32/directx/display.inc} +{$INCLUDE win32/directx/primary.inc} +{$INCLUDE win32/directx/directxconsolei.inc} +{$INCLUDE win32/gdi/win32dibi.inc} +{$INCLUDE win32/gdi/gdiconsolei.inc} +{$ENDIF Win32} + +{$IFDEF WinCE} +{$INCLUDE wince/includes.inc} +{$ENDIF WinCE} + +{$IFDEF UNIX} +{$INCLUDE x11/includes.inc} +{$ENDIF UNIX} + +{$INCLUDE consolei.inc} + +{$IFDEF ENABLE_C_API} +{$INCLUDE c_api/except.pp} +{$INCLUDE c_api/error.pp} +{$INCLUDE c_api/area.pp} +{$INCLUDE c_api/color.pp} +{$INCLUDE c_api/clear.pp} +{$INCLUDE c_api/clipper.pp} +{$INCLUDE c_api/copy.pp} +{$INCLUDE c_api/key.pp} +{$INCLUDE c_api/format.pp} +{$INCLUDE c_api/palette.pp} +{$INCLUDE c_api/surface.pp} +{$INCLUDE c_api/console.pp} +{$INCLUDE c_api/mode.pp} +{$INCLUDE c_api/timer.pp} +{$ENDIF ENABLE_C_API} + +Initialization + +Begin + {$IFDEF ENABLE_C_API} + ptc_error_handler_function := @ptc_error_handler_default; + {$ENDIF ENABLE_C_API} + {$IFDEF WIN32} + TWin32Hook_m_monitor := TWin32Monitor.Create; + {$ENDIF WIN32} +End; + +Finalization + +Begin + {$IFDEF WIN32} + FreeAndNil(TWin32Hook_m_monitor); + {$ENDIF WIN32} +End; + +End. diff --git a/packages/ptc/src/ptcpas.cfg b/packages/ptc/src/ptcpas.cfg new file mode 100644 index 0000000000..4fe0e05c8a --- /dev/null +++ b/packages/ptc/src/ptcpas.cfg @@ -0,0 +1,103 @@ +# +# example ptcpas.cfg, containing all supported options +# remove the '#' to enable an option +# + + + +#### Generic options: #### + +#enable logging +#disable logging + +#attempt dithering + + + +#### DirectX options: #### + +#DirectX + +#default output +#windowed output +#fullscreen output +#default width 320 +#default height 200 +#default bits 32 +#resizable window +#fixed window +#windowed primary direct +#windowed primary secondary +#fullscreen primary direct +#fullscreen primary secondary +#center window +#default window position +#synchronized update +#unsynchronized update +#default nearest +#center nearest +#default stretch +#default cursor +#show cursor +#hide cursor +#frequency 60 +#enable key buffering +#disable key buffering +#enable blocking +#disable blocking + + + +#### VESA options: #### + +#VESA + + + +#### VGA/Fakemode options: #### + +#VGA +#Fakemode + +#FAKEMODE1A +#FAKEMODE1B +#FAKEMODE1C +#FAKEMODE2A +#FAKEMODE2B +#FAKEMODE2C +#FAKEMODE3A +#FAKEMODE3B +#FAKEMODE3C + + + +#### Text mode options: #### + +#Text +#TEXTFX2 + +#charset_b8ibm +#charset_b7asc +#charset_b7sml +#charset_b8gry +#charset_b7nws +#calcpal_colorbase +#calcpal_lightbase +#calcpal_lightbase_g + + + +#### X11 options: #### + +#X11 + +#default output +#windowed output +#fullscreen output +#default cursor +#show cursor +#hide cursor +#leave window open +#leave display open +#dga +#dga off diff --git a/packages/ptc/src/surfaced.inc b/packages/ptc/src/surfaced.inc new file mode 100644 index 0000000000..b304615932 --- /dev/null +++ b/packages/ptc/src/surfaced.inc @@ -0,0 +1,76 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCSurface=Class(TPTCBaseSurface) + Private + {data} + m_width : Integer; + m_height : Integer; + m_pitch : Integer; + m_area : TPTCArea; + m_clip : TPTCArea; + m_format : TPTCFormat; + m_locked : Boolean; + m_pixels : Pointer; + {objects} + m_copy : TPTCCopy; + m_clear : TPTCClear; + m_palette : TPTCPalette; + Public + Constructor Create(_width, _height : Integer; Const _format : TPTCFormat); + Destructor Destroy; Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function Palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function Clip : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function option(Const _option : String) : Boolean; Override; + End; diff --git a/packages/ptc/src/surfacei.inc b/packages/ptc/src/surfacei.inc new file mode 100644 index 0000000000..4b2fbca4eb --- /dev/null +++ b/packages/ptc/src/surfacei.inc @@ -0,0 +1,329 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TPTCSurface.Create(_width, _height : Integer; Const _format : TPTCFormat); + +Var + size : Integer; + +Begin + m_pixels := Nil; + m_copy := Nil; + m_clear := Nil; + m_palette := Nil; + m_format := Nil; + m_area := Nil; + m_clip := Nil; + m_locked := False; + LOG('creating surface'); + LOG('width', _width); + LOG('height', _height); + LOG('format', _format); + m_width := _width; + m_height := _height; + m_format := TPTCFormat.Create(_format); + m_area := TPTCArea.Create(0, 0, width, height); + m_clip := TPTCArea.Create(m_area); + m_pitch := width * _format.bytes; + size := width * height * _format.bytes; + If size = 0 Then + Raise TPTCError.Create('zero surface size'); + m_pixels := GetMem(size); + If m_pixels = Nil Then + Raise TPTCError.Create('could not allocate surface pixels'); + m_copy := TPTCCopy.Create; + m_clear := TPTCClear.Create; + m_palette := TPTCPalette.Create; + clear; +End; + +Destructor TPTCSurface.Destroy; + +Begin + If m_locked Then + Raise TPTCError.Create('surface is still locked'); + m_copy.Free; + m_clear.Free; + m_palette.Free; + m_clip.Free; + m_area.Free; + m_format.Free; + If m_pixels <> Nil Then + FreeMem(m_pixels); + Inherited Destroy; +End; + +Procedure TPTCSurface.copy(Var surface : TPTCBaseSurface); + +Begin + surface.load(m_pixels, m_width, m_height, m_pitch, m_format, m_palette); +End; + +Procedure TPTCSurface.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Begin + surface.load(m_pixels, m_width, m_height, m_pitch, m_format, m_palette, + source, destination); +End; + +Function TPTCSurface.lock : Pointer; + +Begin + If m_locked Then + Raise TPTCError.Create('surface is already locked'); + m_locked := True; + lock := m_pixels; +End; + +Procedure TPTCSurface.unlock; + +Begin + If Not m_locked Then + Raise TPTCError.Create('surface is not locked'); + m_locked := False; +End; + +Procedure TPTCSurface.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); + +Var + Area_ : TPTCArea; + +Begin + If m_clip.Equals(m_area) Then + Begin + m_copy.request(_format, m_format); + m_copy.palette(_palette, m_palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, m_pixels, 0, 0, + m_width, m_height, m_pitch); + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, _width, _height); + Try + load(pixels, _width, _height, _pitch, _format, _palette, Area_, m_area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TPTCSurface.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Var + clipped_source, clipped_destination : TPTCArea; + area_ : TPTCArea; + +Begin + clipped_source := Nil; + clipped_destination := Nil; + area_ := Nil; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + area_ := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, area_, clipped_source, destination, m_clip, + clipped_destination); + m_copy.request(_format, m_format); + m_copy.palette(_palette, m_palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, + clipped_source.width, clipped_source.height, _pitch, + m_pixels, clipped_destination.left, clipped_destination.top, + clipped_destination.width, clipped_destination.height, m_pitch); + Finally + clipped_source.Free; + clipped_destination.Free; + area_.Free; + End; +End; + +Procedure TPTCSurface.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); + +Var + area_ : TPTCArea; + +Begin + If m_clip.Equals(m_area) Then + Begin + m_copy.request(m_format, _format); + m_copy.palette(m_palette, _palette); + m_copy.copy(m_pixels, 0, 0, m_width, m_height, m_pitch, pixels, 0, 0, + _width, _height, _pitch); + End + Else + Begin + area_ := TPTCArea.Create(0, 0, width, height); + Try + save(pixels, _width, _height, _pitch, _format, _palette, m_area, area_); + Finally + area_.Free; + End; + End; +End; + +Procedure TPTCSurface.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); + +Var + clipped_source, clipped_destination : TPTCArea; + area_ : TPTCArea; + +Begin + clipped_source := Nil; + clipped_destination := Nil; + area_ := Nil; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + area_ := TPTCArea.Create(0, 0, _width, _height); + TPTCClipper.clip(source, m_clip, clipped_source, destination, area_, + clipped_destination); + m_copy.request(m_format, _format); + m_copy.palette(m_palette, _palette); + m_copy.copy(m_pixels, clipped_source.left, clipped_source.top, + clipped_source.width, clipped_source.height, m_pitch, + pixels, clipped_destination.left, clipped_destination.top, + clipped_destination.width, clipped_destination.height, _pitch); + Finally + clipped_source.Free; + clipped_destination.Free; + area_.Free; + End; +End; + +Procedure TPTCSurface.clear; + +Var + Color : TPTCColor; + +Begin + If format.direct Then + Color := TPTCColor.Create(0, 0, 0, 0) + Else + Color := TPTCColor.Create(0); + Try + clear(Color); + Finally + Color.Free; + End; +End; + +Procedure TPTCSurface.clear(Const color : TPTCColor); + +Begin + clear(color, m_area); +End; + +Procedure TPTCSurface.clear(Const color : TPTCColor; Const _area : TPTCArea); + +Var + clipped_area : TPTCArea; + +Begin + clipped_area := TPTCClipper.clip(_area, m_clip); + Try + m_clear.request(m_format); + m_clear.clear(m_pixels, clipped_area.left, clipped_area.top, + clipped_area.width, clipped_area.height, m_pitch, color); + Finally + clipped_area.Free; + End; +End; + +Procedure TPTCSurface.palette(Const _palette : TPTCPalette); + +Begin + m_palette.load(_palette.data^); +End; + +Function TPTCSurface.Palette : TPTCPalette; + +Begin + Result := m_palette; +End; + +Procedure TPTCSurface.clip(Const _area : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + tmp := TPTCClipper.clip(_area, m_area); + Try + m_clip.Assign(tmp); + Finally + tmp.Free; + End; +End; + +Function TPTCSurface.GetWidth : Integer; + +Begin + Result := m_width; +End; + +Function TPTCSurface.GetHeight : Integer; + +Begin + Result := m_height; +End; + +Function TPTCSurface.GetPitch : Integer; + +Begin + Result := m_pitch; +End; + +Function TPTCSurface.GetArea : TPTCArea; + +Begin + Result := m_area; +End; + +Function TPTCSurface.Clip : TPTCArea; + +Begin + Result := m_clip; +End; + +Function TPTCSurface.GetFormat : TPTCFormat; + +Begin + Result := m_format; +End; + +Function TPTCSurface.option(Const _option : String) : Boolean; + +Begin + Result := m_copy.option(_option); +End; diff --git a/packages/ptc/src/timerd.inc b/packages/ptc/src/timerd.inc new file mode 100644 index 0000000000..af2f603801 --- /dev/null +++ b/packages/ptc/src/timerd.inc @@ -0,0 +1,47 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TPTCTimer=Class(TObject) + Private + m_old : Double; + m_time : Double; + m_start : Double; + m_current : Double; + m_running : Boolean; + {$IFDEF WIN32} + m_frequency : QWord; + {$ENDIF WIN32} + Function clock : Double; + Procedure internal_init_timer; + Public + Constructor Create; + Constructor Create(_time : Double); + Constructor Create(Const timer : TPTCTimer); + Destructor Destroy; Override; + Procedure Assign(Const timer : TPTCTimer); + Function Equals(Const timer : TPTCTimer) : Boolean; + Procedure settime(_time : Double); {was 'set' in the C++ version} + Procedure start; + Procedure stop; + Function time : Double; + Function delta : Double; + Function resolution : Double; + End; diff --git a/packages/ptc/src/timeri.inc b/packages/ptc/src/timeri.inc new file mode 100644 index 0000000000..10dab34eae --- /dev/null +++ b/packages/ptc/src/timeri.inc @@ -0,0 +1,215 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{Function timeGetTime : DWord; StdCall; External 'WINMM' name 'timeGetTime';} + +Constructor TPTCTimer.Create; + +Begin + internal_init_timer; + m_old := 0; + m_time := 0; + m_start := 0; + m_current := 0; + m_running := False; +End; + +Constructor TPTCTimer.Create(_time : Double); + +Begin + internal_init_timer; + m_old := 0; + m_time := 0; + m_start := 0; + m_current := 0; + m_running := False; + settime(_time); +End; + +Constructor TPTCTimer.Create(Const timer : TPTCTimer); + +Begin + internal_init_timer; + Assign(timer); +End; + +Destructor TPTCTimer.Destroy; + +Begin + stop; + Inherited Destroy; +End; + +Procedure TPTCTimer.Assign(Const timer : TPTCTimer); + +Begin + If Self = timer Then + Raise TPTCError.Create('self assignment is not allowed'); + + m_old := timer.m_old; + m_time := timer.m_time; + m_start := timer.m_start; + m_current := timer.m_current; + m_running := timer.m_running; +End; + +Function TPTCTimer.Equals(Const timer : TPTCTimer) : Boolean; + +Begin + Equals := (m_old = timer.m_old) And (m_time = timer.m_time) And + (m_start = timer.m_start) And (m_current = timer.m_current) And + (m_running = timer.m_running); +End; + +Procedure TPTCTimer.settime(_time : Double); + +Begin + m_current := _time; + m_start := clock; + m_time := m_start + _time; + m_old := m_time - delta; +End; + +Procedure TPTCTimer.start; + +Begin + If Not m_running Then + Begin + m_start := clock; + m_old := clock; + m_running := True; + End; +End; + +Procedure TPTCTimer.stop; + +Begin + m_running := False; +End; + +Function TPTCTimer.time : Double; + +Var + _time : Double; + +Begin + If m_running Then + Begin + _time := clock; + If _time > m_time Then + m_time := _time; + m_current := m_time - m_start; + End; + time := m_current; +End; + +Function TPTCTimer.delta : Double; + +Var + _time : Double; + _delta : Double; + +Begin + If m_running Then + Begin + _time := clock; + _delta := _time - m_old; + m_old := _time; + If _delta < 0 Then + _delta := 0; + delta := _delta; + End + Else + delta := 0; +End; + +Function TPTCTimer.resolution : Double; + +Begin + {$IFDEF GO32V2} + Result := TimerResolution; + {$ENDIF GO32V2} + {$IFDEF Win32} + Result := 1 / m_frequency; +{ Result := 1 / 1000;} + {$ENDIF Win32} + {$IFDEF WinCE} + Result := 1 / 1000; + {$ENDIF WinCE} + {$IFDEF UNIX} + Result := 1 / 1000000; + {$ENDIF UNIX} +End; + +Procedure TPTCTimer.internal_init_timer; + +{$IFDEF WIN32} +Var + _freq : QWord; +{$ENDIF WIN32} + +Begin +{$IFDEF WIN32} + QueryPerformanceFrequency(PLARGE_INTEGER(@_freq)); + m_frequency := _freq; +{$ENDIF WIN32} +End; + +{$IFDEF GO32V2} +Function TPTCTimer.clock : Double; + +Begin + clock := GetClockTics() * TimerResolution; +End; +{$ENDIF GO32V2} + +{$IFDEF Win32} +Function TPTCTimer.clock : Double; + +Var + _time : QWord; + +Begin + QueryPerformanceCounter(PLARGE_INTEGER(@_time)); + clock := _time / m_frequency; +{ clock := timeGetTime / 1000;} +End; +{$ENDIF Win32} + +{$IFDEF WinCE} +Function TPTCTimer.clock : Double; + +Begin + Result := GetTickCount / 1000; +End; +{$ENDIF WinCE} + +{$IFDEF UNIX} +Function TPTCTimer.clock : Double; + +Var + tm : TimeVal; + +Begin + fpGetTimeOfDay(@tm, Nil); + clock := tm.tv_sec + (Double(tm.tv_usec)) / 1000000; +End; +{$ENDIF UNIX} + diff --git a/packages/ptc/src/tinyptc/tinyptc.pp b/packages/ptc/src/tinyptc/tinyptc.pp new file mode 100644 index 0000000000..91d2b8cfef --- /dev/null +++ b/packages/ptc/src/tinyptc/tinyptc.pp @@ -0,0 +1,60 @@ +{todo: handle exceptions} + +Unit TinyPTC; + +{$MODE objfpc} + +Interface + +Function ptc_open(title : String; width, height : Integer) : Boolean; +Function ptc_update(buffer : Pointer) : Boolean; +Procedure ptc_close; + +Implementation + +Uses + ptc; + +Var + console : TPTCConsole; + format : TPTCFormat; + palette : TPTCPalette; + w, h : Integer; + +Function ptc_open(title : String; width, height : Integer) : Boolean; + +Begin + If console = Nil Then + console := TPTCConsole.Create; + If format = Nil Then + format := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + If palette = Nil Then + palette := TPTCPalette.Create; + console.open(title, width, height, format); + w := width; + h := height; + ptc_open := True; +End; + +Function ptc_update(buffer : Pointer) : Boolean; + +Begin + console.load(buffer, w, h, w*4, format, palette); + ptc_update := True; +End; + +Procedure ptc_close; + +Begin + If console <> Nil Then + console.close; + FreeAndNil(console); + FreeAndNil(format); + FreeAndNil(palette); +End; + +Initialization + console := Nil; +Finalization + ptc_close; +End. diff --git a/packages/ptc/src/win32/base/cursor.inc b/packages/ptc/src/win32/base/cursor.inc new file mode 100644 index 0000000000..2c5e6438c4 --- /dev/null +++ b/packages/ptc/src/win32/base/cursor.inc @@ -0,0 +1,33 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Procedure Win32Cursor_resurrect; + +Begin + LOG('showing cursor'); + While ShowCursor(True) < 0 Do; +End; + +Procedure Win32Cursor_kill; + +Begin + LOG('hiding cursor'); + While ShowCursor(False) >= 0 Do; +End; diff --git a/packages/ptc/src/win32/base/event.inc b/packages/ptc/src/win32/base/event.inc new file mode 100644 index 0000000000..5c284dd97c --- /dev/null +++ b/packages/ptc/src/win32/base/event.inc @@ -0,0 +1,60 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TWin32Event.Create; + +Begin + { create event handle } + m_event := CreateEvent(Nil, True, False, Nil); + + { check event handle } + If m_event = 0 Then + Raise TPTCError.Create('could not create event'); +End; + +Destructor TWin32Event.Destroy; + +Begin + { close handle } + CloseHandle(m_event); + + Inherited Destroy; +End; + +Procedure TWin32Event._set; + +Begin + { set event } + SetEvent(m_event); +End; + +Procedure TWin32Event.reset; + +Begin + { reset event } + ResetEvent(m_event); +End; + +Procedure TWin32Event.wait; + +Begin + { wait for event } + WaitForSingleObject(m_event, INFINITE); +End; diff --git a/packages/ptc/src/win32/base/eventd.inc b/packages/ptc/src/win32/base/eventd.inc new file mode 100644 index 0000000000..d7948eeebc --- /dev/null +++ b/packages/ptc/src/win32/base/eventd.inc @@ -0,0 +1,38 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Event = Class(TObject) + Private + { event handle } + m_event : HANDLE; + Public + { setup } + Constructor Create; + Destructor Destroy; Override; + + { control } + Procedure _set; + Procedure reset; + Procedure wait; + + { data access } + Property handle : HANDLE read m_event; + End; diff --git a/packages/ptc/src/win32/base/hook.inc b/packages/ptc/src/win32/base/hook.inc new file mode 100644 index 0000000000..87f72b7432 --- /dev/null +++ b/packages/ptc/src/win32/base/hook.inc @@ -0,0 +1,253 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + PWin32Hook_Lookup = ^TWin32Hook_Lookup; + TWin32Hook_Lookup = Record + window : HWND; + wndproc : DWord; + hook : Array[0..15] Of TWin32Hook; + count : Integer; + End; + +Const + TWin32Hook_m_count : Integer = 0; + TWin32Hook_m_cached : PWin32Hook_Lookup = Nil; + TWin32Hook_m_monitor : TWin32Monitor = Nil; + +Var +{ TWin32Hook_m_hook : HHOOK;} + TWin32Hook_m_registry : Array[0..15] Of TWin32Hook_Lookup; + +Function TWin32Hook_hook(hwnd : HWND; msg : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall; + +Var + lookup : PWin32Hook_Lookup; + i : Integer; + +Begin + { enter monitor } + TWin32Hook_m_monitor.enter; + + { lookup pointer } + lookup := Nil; + + { check cached lookup if valid } + If (TWin32Hook_m_cached <> Nil) And (TWin32Hook_m_cached^.window = hwnd) Then + { cached lookup match } + lookup := TWin32Hook_m_cached + Else + Begin + { search for matching window } + For i := 0 To TWin32Hook_m_count - 1 Do + { check for lookup window match } + If TWin32Hook_m_registry[i].window = hwnd Then + Begin + { setup cached lookup } + TWin32Hook_m_cached := @TWin32Hook_m_registry[i]; + + { setup lookup } + lookup := TWin32Hook_m_cached; + + { break } + Break; + End; +{$IFDEF DEBUG} + { check for search failure } + If lookup = Nil Then + Raise TPTCError.Create('TWin32Hook window lookup search failure!'); +{$ENDIF} + End; + + { result value } + TWin32Hook_hook := 0; + + { iterate all hooks for this window } + For i := lookup^.count - 1 DownTo 0 Do + Begin + { call hook window procedure } + TWin32Hook_hook := lookup^.hook[i].WndProc(hwnd, msg, wParam, lParam); + + { check result value ? } + {If result = True Then Break;} + End; + + { check result } + {If result <> True Then} + + { call original window procedure } + result := CallWindowProc(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam); + + { leave monitor } + TWin32Hook_m_monitor.leave; +End; + +Constructor TWin32Hook.Create(window : HWND; thread : DWord); + +Begin + { setup data } + m_window := window; + m_thread := thread; + + { add to registry } + add(m_window, m_thread); +End; + +Destructor TWin32Hook.Destroy; + +Begin + { remove from registry } + remove(m_window, m_thread); + Inherited Destroy; +End; + +Procedure TWin32Hook.Add(window : HWND; thread : DWord); + +Var + index, insert : Integer; + +Begin + { enter monitor } + TWin32Hook_m_monitor.enter; + + { invalidate cache } + TWin32Hook_m_cached := Nil; + + { registry index } + index := 0; + + { iterate registry } + While index < TWin32Hook_m_count Do + Begin + { search for existing window hook } + If TWin32Hook_m_registry[index].window = window Then + { match } + Break; + + { next } + Inc(index); + End; + + { check results } + If index <> TWin32Hook_m_count Then + Begin + { get insertion point for hook } + insert := TWin32Hook_m_registry[index].count; + + { increase hook count } + Inc(TWin32Hook_m_registry[index].count); + +{$IFDEF DEBUG} + { Check for maximum hook count } + If TWin32Hook_m_registry[index].count > (High(TWin32Hook_m_registry[index].hook) + 1) Then + Raise TPTCError.Create('TWin32Hook too many hooks created!'); +{$ENDIF} + + { insert hook in registry } + TWin32Hook_m_registry[index].hook[insert] := Self; + End + Else + Begin + { setup new lookup } + TWin32Hook_m_registry[index].wndproc := GetWindowLong(window, GWL_WNDPROC); + TWin32Hook_m_registry[index].window := window; + TWin32Hook_m_registry[index].hook[0] := Self; + TWin32Hook_m_registry[index].count := 1; + + { increase lookup count } + Inc(TWin32Hook_m_count); + +{$IFDEF DEBUG} + { check for maximum count } + If TWin32Hook_m_count > (High(TWin32Hook_m_registry) + 1) Then + Raise TPTCError.Create('TWin32Hook too many lookups created!'); +{$ENDIF} + + { set window procedure to hook procedure } + SetWindowLong(window, GWL_WNDPROC, DWord(@TWin32Hook_hook)); + End; + + { leave monitor } + TWin32Hook_m_monitor.leave; +End; + +Procedure TWin32Hook.Remove(window : HWND; thread : DWord); + +Var + index, i, j : Integer; + +Begin + { enter monitor } + TWin32Hook_m_monitor.enter; + + { invalidate cache } + TWin32Hook_m_cached := Nil; + + { registry index } + index := 0; + + { iterate registry } + While index < TWin32Hook_m_count Do + Begin + { check for window match } + If TWin32Hook_m_registry[index].window = window Then + Begin + { search for Self } + For i := 0 To TWin32Hook_m_registry[index].count Do + { check hook } + If TWin32Hook_m_registry[index].hook[i] = Self Then + Begin + { remove this hook (quite inefficient for high count...) } + For j := i To TWin32Hook_m_registry[index].count - 2 Do + TWin32Hook_m_registry[index].hook[j] := + TWin32Hook_m_registry[index].hook[j + 1]; + + { decrease hook count } + Dec(TWin32Hook_m_registry[index].count); + + { break } + Break; + End; + + { check remaining hook count } + If TWin32Hook_m_registry[index].count = 0 Then + Begin + { restore original window procedure } + SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc); + + { remove this lookup (quite inefficient for high count...) } + For i := index To TWin32Hook_m_count - 2 Do + TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1]; + + { decrease count } + Dec(TWin32Hook_m_count); + End; + + { break } + Break; + End; + + { next } + Inc(index); + End; + + { leave monitor } + TWin32Hook_m_monitor.leave; +End; diff --git a/packages/ptc/src/win32/base/hookd.inc b/packages/ptc/src/win32/base/hookd.inc new file mode 100644 index 0000000000..286680b993 --- /dev/null +++ b/packages/ptc/src/win32/base/hookd.inc @@ -0,0 +1,40 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Hook = Class(TObject) + Private + Procedure Add(window : HWND; thread : DWord); + Procedure Remove(window : HWND; thread : DWord); + + m_window : HWND; + m_thread : DWord; + + {m_hook : HHOOK; + m_count : Integer; + m_cached : PWin32Hook_Lookup; + m_registry : Array[0..15] Of TWin32Hook_Lookup; + m_monitor : TWin32Monitor;} + Protected + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Virtual; Abstract; + Public + Constructor Create(window : HWND; thread : DWord); + Destructor Destroy; Override; + End; diff --git a/packages/ptc/src/win32/base/kbd.inc b/packages/ptc/src/win32/base/kbd.inc new file mode 100644 index 0000000000..fa2c7a209d --- /dev/null +++ b/packages/ptc/src/win32/base/kbd.inc @@ -0,0 +1,283 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TWin32Keyboard.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue); + +Begin + m_monitor := Nil; + m_event := Nil; + Inherited Create(window, thread); + m_monitor := TWin32Monitor.Create; + m_event := TWin32Event.Create; + + { setup defaults } + m_alt := False; + m_shift := False; + m_control := False; + + { setup data } + FEventQueue := EventQueue; + m_multithreaded := multithreaded; + + { enable buffering } + m_enabled := True; +End; + +Destructor TWin32Keyboard.Destroy; + +Begin + m_event.Free; + m_monitor.Free; + Inherited Destroy; +End; + +(*Function TWin32Keyboard.internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean; + +Begin + { check enabled flag } + If Not m_enabled Then + Begin + Result := False; + Exit; + End; + + { enter monitor if multithreaded } + If m_multithreaded Then + m_monitor.enter; + + { update window } + window.update; + + { is a key ready? } + Result := ready; + + If Result = True Then + k.Assign(m_buffer[m_tail]); + + { leave monitor if multithreaded } + If m_multithreaded Then + m_monitor.leave; +End; + +Procedure TWin32Keyboard.internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent); + +Var + read : TPTCKeyEvent; + +Begin + read := Nil; + + Try + { check enabled flag } + If Not m_enabled Then + Begin + read := TPTCKeyEvent.Create; + Exit; + End; + + { check if multithreaded } + If m_multithreaded Then + Begin + { check if ready } + If Not ready Then + Begin + { wait for key event } + m_event.wait; + + { reset event } + m_event.reset; + End; + + { enter monitor } + m_monitor.enter; + + { remove key } + read := remove; + + { leave monitor } + m_monitor.leave; + End + Else + Begin + { update until ready } + While Not ready Do + { update window } + window.update; + + { remove key } + read := remove; + End; + Finally + If Assigned(read) Then + k.Assign(read); + read.Free; + End; +End;*) + +Procedure TWin32Keyboard.enable; + +Begin + { enable buffering } + m_enabled := True; +End; + +Procedure TWin32Keyboard.disable; + +Begin + { disable buffering } + m_enabled := False; +End; + +Function TWin32Keyboard.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + +Var + i : Integer; + scancode : Integer; + KeyStateArray : Array[0..255] Of Byte; + AsciiBuf : Word; + press : Boolean; + uni : Integer; + tmp : Integer; + +Begin + WndProc := 0; + { check enabled flag } + If Not m_enabled Then + Exit; + + { process key message } + If (message = WM_KEYDOWN) Or (message = WM_KEYUP) {Or ((message = WM_SYSKEYDOWN) And ((lParam And (1 Shl 29)) <> 0))} Then + Begin + If message = WM_KEYUP Then + press := False + Else + press := True; + + { update modifiers } + If wParam = VK_MENU Then + { alt } + m_alt := press + Else + If wParam = VK_SHIFT Then + { shift } + m_shift := press + Else + If wParam = VK_CONTROL Then + { control } + m_control := press; + + { enter monitor if multithreaded } + If m_multithreaded Then + m_monitor.enter; + + uni := -1; + + If GetKeyboardState(@KeyStateArray) Then + Begin + scancode := (lParam Shr 16) And $FF; + {todo: ToUnicode (Windows NT)} + tmp := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0); + If (tmp = 1) Or (tmp = 2) Then + Begin + If tmp = 2 Then + Begin +// Writeln('[', AsciiBuf, ']'); {???? todo: dead keys ????} + End + Else + Begin +// Write(Chr(AsciiBuf)); + {todo: codepage -> unicode} + If AsciiBuf <= 126 Then + uni := AsciiBuf; + End; + + End; + End; + + { handle key repeat count } + For i := 1 To lParam And $FFFF Do + { create and insert key object } + FEventQueue.AddEvent(TPTCKeyEvent.Create(wParam, uni, m_alt, m_shift, m_control, press)); + + { check multithreaded flag } + If m_multithreaded Then + Begin + { set event } + m_event._set; + + { leave monitor } + m_monitor.leave; + End; + End; +(* Else + If message = WM_KEYUP Then + { update modifiers } + If wParam = VK_MENU Then + { alt up } + m_alt := False + Else + If wParam = VK_SHIFT Then + { shift up } + m_shift := False + Else + If wParam = VK_CONTROL Then + { control up } + m_control := False;*) +End; + +(*Procedure TWin32Keyboard.insert(_key : TPTCKeyEvent); + +Begin + { check for overflow } + If (m_head <> (m_tail - 1)) And + ((m_tail <> 0) Or (m_head <> High(m_buffer))) Then + Begin + { insert key at head } + m_buffer[m_head] := _key; + + { increase head } + Inc(m_head); + + { wrap head from end to start } + If m_head > High(m_buffer) Then + m_head := Low(m_buffer); + End; +End; + +Function TWin32Keyboard.remove : TPTCKeyEvent; + +Begin + { return key data from tail } + remove := m_buffer[m_tail]; + + { increase tail } + Inc(m_tail); + + { wrap tail from end to start } + If m_tail > High(m_buffer) Then + m_tail := Low(m_buffer); +End; + +Function TWin32Keyboard.ready : Boolean; + +Begin + ready := m_head <> m_tail; +End; +*) diff --git a/packages/ptc/src/win32/base/kbdd.inc b/packages/ptc/src/win32/base/kbdd.inc new file mode 100644 index 0000000000..8cd947008b --- /dev/null +++ b/packages/ptc/src/win32/base/kbdd.inc @@ -0,0 +1,63 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Keyboard = Class(TWin32Hook) + Private + { window procedure } + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override; + + { internal key functions } +{ Procedure insert(_key : TPTCKeyEvent); + Function remove : TPTCKeyEvent; + Function ready : Boolean;} + + { data } +{ m_key : Boolean;} + m_multithreaded : Boolean; + m_event : TWin32Event; + m_monitor : TWin32Monitor; + FEventQueue : TEventQueue; + + { flag data } + m_enabled : Boolean; + + { modifiers } + m_alt : Boolean; + m_shift : Boolean; + m_control : Boolean; + + { key buffer } +{ m_head : Integer; + m_tail : Integer; + m_buffer : Array[0..1023] Of TPTCKeyEvent;} + Public + { setup } + Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue); + Destructor Destroy; Override; + + { input } +{ Function internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean; + Procedure internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent);} + + { control } + Procedure enable; + Procedure disable; + End; diff --git a/packages/ptc/src/win32/base/monitor.inc b/packages/ptc/src/win32/base/monitor.inc new file mode 100644 index 0000000000..7e40c13972 --- /dev/null +++ b/packages/ptc/src/win32/base/monitor.inc @@ -0,0 +1,54 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{ $DEFINE __DISABLE_MULTITHREADING__} + +Constructor TWin32Monitor.Create; + +Begin +{$IFNDEF __DISABLE_MULTITHREADING__} + InitializeCriticalSection(m_handle); +{$ENDIF} +End; + +Destructor TWin32Monitor.Destroy; + +Begin +{$IFNDEF __DISABLE_MULTITHREADING__} + DeleteCriticalSection(m_handle); +{$ENDIF} + Inherited Destroy; +End; + +Procedure TWin32Monitor.enter; + +Begin +{$IFNDEF __DISABLE_MULTITHREADING__} + EnterCriticalSection(m_handle); +{$ENDIF} +End; + +Procedure TWin32Monitor.leave; + +Begin +{$IFNDEF __DISABLE_MULTITHREADING__} + LeaveCriticalSection(m_handle); +{$ENDIF} +End; diff --git a/packages/ptc/src/win32/base/monitord.inc b/packages/ptc/src/win32/base/monitord.inc new file mode 100644 index 0000000000..ea4cd806ec --- /dev/null +++ b/packages/ptc/src/win32/base/monitord.inc @@ -0,0 +1,30 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Monitor = Class(TObject) + Private + m_handle : CRITICAL_SECTION; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure enter; + Procedure leave; + End; diff --git a/packages/ptc/src/win32/base/moused.inc b/packages/ptc/src/win32/base/moused.inc new file mode 100644 index 0000000000..dfaa911c86 --- /dev/null +++ b/packages/ptc/src/win32/base/moused.inc @@ -0,0 +1,55 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Mouse = Class(TWin32Hook) + Private + { window procedure } + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override; + + FEventQueue : TEventQueue; + + FFullScreen : Boolean; + + { the actual image area, inside the window (top left and bottom right corner) } + FWindowX1, FWindowY1, FWindowX2, FWindowY2 : Integer; + + { console resolution + - mouse cursor position as seen by the user must always be in range: + [0..FConsoleWidth-1, 0..FConsoleHeight-1] } + FConsoleWidth, FConsoleHeight : Integer; + + FPreviousMouseButtonState : TPTCMouseButtonState; + FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas } + FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX, + FPreviousMouseY and FPreviousMouseButtonState contain valid values } + + { flag data } + FEnabled : Boolean; + Public + { setup } + Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer); + + Procedure SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer); + + { control } + Procedure enable; + Procedure disable; + End; diff --git a/packages/ptc/src/win32/base/mousei.inc b/packages/ptc/src/win32/base/mousei.inc new file mode 100644 index 0000000000..87500f6a39 --- /dev/null +++ b/packages/ptc/src/win32/base/mousei.inc @@ -0,0 +1,176 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TWin32Mouse.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer); + +Begin + Inherited Create(window, thread); + + FEventQueue := EventQueue; + + FFullScreen := FullScreen; + FConsoleWidth := ConsoleWidth; + FConsoleHeight := ConsoleHeight; + + FPreviousMousePositionSaved := False; + + { enable buffering } + FEnabled := True; +End; + +Procedure TWin32Mouse.SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer); + +Begin + FWindowX1 := WindowX1; + FWindowY1 := WindowY1; + FWindowX2 := WindowX2; + FWindowY2 := WindowY2; +End; + +Procedure TWin32Mouse.enable; + +Begin + { enable buffering } + FEnabled := True; +End; + +Procedure TWin32Mouse.disable; + +Begin + { disable buffering } + FEnabled := False; +End; + +Function TWin32Mouse.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + +Var + fwKeys : Integer; + xPos, yPos : Integer; + LButton, MButton, RButton : Boolean; + TranslatedXPos, TranslatedYPos : Integer; + PTCMouseButtonState : TPTCMouseButtonState; + WindowRect : RECT; + + button : TPTCMouseButton; + before, after : Boolean; + cstate : TPTCMouseButtonState; + +Begin + Result := 0; + { check enabled flag } + If Not FEnabled Then + Exit; + + If (message = WM_MOUSEMOVE) Or + (message = WM_LBUTTONDOWN) Or (message = WM_LBUTTONUP) Or (message = WM_LBUTTONDBLCLK) Or + (message = WM_MBUTTONDOWN) Or (message = WM_MBUTTONUP) Or (message = WM_MBUTTONDBLCLK) Or + (message = WM_RBUTTONDOWN) Or (message = WM_RBUTTONUP) Or (message = WM_RBUTTONDBLCLK) Then + Begin + fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT} + xPos := lParam And $FFFF; + yPos := (lParam Shr 16) And $FFFF; + + LButton := (fwKeys And MK_LBUTTON) <> 0; + MButton := (fwKeys And MK_MBUTTON) <> 0; + RButton := (fwKeys And MK_RBUTTON) <> 0; + + If Not FFullScreen Then + Begin + GetClientRect(hWnd, WindowRect); + + FWindowX1 := WindowRect.left; + FWindowY1 := WindowRect.top; + FWindowX2 := WindowRect.right - 1; + FWindowY2 := WindowRect.bottom - 1; + End; + + If (xPos >= FWindowX1) And (yPos >= FWindowY1) And + (xPos <= FWindowX2) And (yPos <= FWindowY2) Then + Begin + If FWindowX2 <> FWindowX1 Then + TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth - 1) Div (FWindowX2 - FWindowX1) + Else { avoid div by zero } + TranslatedXPos := 0; + + If FWindowY2 <> FWindowY1 Then + TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) Div (FWindowY2 - FWindowY1) + Else { avoid div by zero } + TranslatedYPos := 0; + + { Just in case... } + If TranslatedXPos < 0 Then + TranslatedXPos := 0; + If TranslatedYPos < 0 Then + TranslatedYPos := 0; + If TranslatedXPos >= FConsoleWidth Then + TranslatedXPos := FConsoleWidth - 1; + If TranslatedYPos >= FConsoleHeight Then + TranslatedYPos := FConsoleHeight - 1; + + If Not LButton Then + PTCMouseButtonState := [] + Else + PTCMouseButtonState := [PTCMouseButton1]; + + If RButton Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2]; + + If MButton Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3]; + + If Not FPreviousMousePositionSaved Then + Begin + FPreviousMouseX := TranslatedXPos; { first DeltaX will be 0 } + FPreviousMouseY := TranslatedYPos; { first DeltaY will be 0 } + FPreviousMouseButtonState := []; + End; + + { movement? } + If (TranslatedXPos <> FPreviousMouseX) Or (TranslatedYPos <> FPreviousMouseY) Then + FEventQueue.AddEvent(TPTCMouseEvent.Create(TranslatedXPos, TranslatedYPos, TranslatedXPos - FPreviousMouseX, TranslatedYPos - FPreviousMouseY, FPreviousMouseButtonState)); + + { button presses/releases? } + cstate := FPreviousMouseButtonState; + For button := Low(button) To High(button) Do + Begin + before := button In FPreviousMouseButtonState; + after := button In PTCMouseButtonState; + If after And (Not before) Then + Begin + { button was pressed } + cstate := cstate + [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, True, button)); + End + Else + If before And (Not after) Then + Begin + { button was released } + cstate := cstate - [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, button)); + End; + End; + + FPreviousMouseX := TranslatedXPos; + FPreviousMouseY := TranslatedYPos; + FPreviousMouseButtonState := PTCMouseButtonState; + FPreviousMousePositionSaved := True; + End; + End; +End; diff --git a/packages/ptc/src/win32/base/ptcres.rc b/packages/ptc/src/win32/base/ptcres.rc new file mode 100644 index 0000000000..2ce506383b --- /dev/null +++ b/packages/ptc/src/win32/base/ptcres.rc @@ -0,0 +1,2 @@ +IDI_PTC_ICON ICON "windows.ico" +#AppIcon ICON "windows.ico" diff --git a/packages/ptc/src/win32/base/ptcres.res b/packages/ptc/src/win32/base/ptcres.res Binary files differnew file mode 100644 index 0000000000..c320585c44 --- /dev/null +++ b/packages/ptc/src/win32/base/ptcres.res diff --git a/packages/ptc/src/win32/base/window.inc b/packages/ptc/src/win32/base/window.inc new file mode 100644 index 0000000000..799a61cf84 --- /dev/null +++ b/packages/ptc/src/win32/base/window.inc @@ -0,0 +1,335 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{ $R win32\base\ptcres.res} + +{ bug in the compiler???} +{ $LINKLIB ptc.owr} + +Constructor TWin32Window.Create(window : HWND); + +Begin + LOG('attaching to user managed window'); + defaults; + m_window := window; + m_managed := False; +End; + +Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer); + +Begin + internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, data); +End; + +Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean); + +Begin + internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, Nil); +End; + +Destructor TWin32Window.Destroy; + +Begin + close; + Inherited Destroy; +End; + +Procedure TWin32Window.cursor(flag : Boolean); + +Begin + If flag Then + Begin + SetClassLong(m_window, GCL_HCURSOR, LoadCursor(0, IDC_ARROW)); + End + Else + Begin + SetClassLong(m_window, GCL_HCURSOR, 0); + End; + SendMessage(m_window, WM_SETCURSOR, 0, 0); +End; + +Procedure TWin32Window.resize(width, height : Integer); + +Var + window_rectangle : RECT; + rectangle : RECT; + +Begin + GetWindowRect(m_window, window_rectangle); + With rectangle Do + Begin + left := 0; + top := 0; + right := width; + bottom := height; + End; + AdjustWindowRectEx(rectangle, m_style, False, m_extra); + SetWindowPos(m_window, HWND_TOP, window_rectangle.left, + window_rectangle.top, rectangle.right - rectangle.left, + rectangle.bottom - rectangle.top, 0); + { + todo: detect if the window is resized off the screen and let windows reposition it correctly... ? + } +End; + +Procedure TWin32Window.update(force : Boolean); + +Var + message : MSG; + +Begin + If (Not m_managed) And (Not force) Then + Exit; + If Not m_multithreaded Then + Begin + While PeekMessage(message, m_window, 0, 0, PM_REMOVE) Do + Begin + TranslateMessage(message); + DispatchMessage(message); + End; + End + Else + Sleep(0); +End; + +Procedure TWin32Window.update; {force = False} + +Begin + update(False); +End; + +Function TWin32Window.handle : HWND; + +Begin + handle := m_window; +End; + +Function TWin32Window.thread : DWord; + +Begin + If m_multithreaded Then + thread := m_id + Else + thread := GetCurrentThreadId; +End; + +Function TWin32Window.managed : Boolean; + +Begin + managed := m_managed; +End; + +Function TWin32Window.multithreaded : Boolean; + +Begin + multithreaded := m_multithreaded; +End; + +Function WndProcSingleThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall; + +Begin + Case message Of + WM_CLOSE : Begin + LOG('TWin32Window WM_CLOSE'); + Halt(0); + End; + Else + WndProcSingleThreaded := DefWindowProc(hWnd, message, wParam, lParam); + End; +End; + +Function WndProcMultiThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall; + +Begin + WndProcMultiThreaded := 0; + Case message Of + WM_DESTROY : Begin + LOG('TWin32Window WM_DESTROY'); + PostQuitMessage(0); + End; + WM_CLOSE : Begin + LOG('TWin32Window WM_CLOSE'); + Halt(0); + End; + Else + WndProcMultiThreaded := DefWindowProc(hWnd, message, wParam, lParam); + End; +End; + +Procedure TWin32Window.internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer); + +Var + program_instance{, library_instance} : DWord; + rectangle : RECT; + display_width, display_height : Integer; + wc : WNDCLASSEX; + +Begin + LOG('creating managed window'); + defaults; + m_multithreaded := _multithreaded; + wndclass := wndclass + #0; + title := title + #0; + Try + program_instance := GetModuleHandle(Nil); +{ library_instance := program_instance;} + wc.cbSize := SizeOf(WNDCLASSEX); + wc.hInstance := program_instance; + wc.lpszClassName := @wndclass[1]; + wc.style := CS_VREDRAW Or CS_HREDRAW; + wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')}; + wc.hIconSm := 0; + wc.lpszMenuName := Nil; + wc.cbClsExtra := 0; + wc.cbWndExtra := 0; + wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)} + If multithreaded Then + wc.lpfnWndProc := @WndProcMultiThreaded + Else + wc.lpfnWndProc := @WndProcSingleThreaded; + wc.hCursor := LoadCursor(0, IDC_ARROW); + RegisterClassEx(wc); + With rectangle Do + Begin + left := 0; + top := 0; + right := width; + bottom := height; + End; + AdjustWindowRectEx(rectangle, style, False, extra); + If center Then + Begin + LOG('centering window'); + display_width := GetSystemMetrics(SM_CXSCREEN); + display_height := GetSystemMetrics(SM_CYSCREEN); + x := (display_width - (rectangle.right - rectangle.left)) Div 2; + y := (display_height - (rectangle.bottom - rectangle.top)) Div 2; + End; + m_name := wndclass; + m_title := title; + m_extra := extra; + m_style := style; + m_show := show; + m_x := x; + m_y := y; + m_width := rectangle.right - rectangle.left; + m_height := rectangle.bottom - rectangle.top; + m_data := data; + If multithreaded Then + Begin + {...} + End + Else + Begin + m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data); + If Not IsWindow(m_window) Then + Raise TPTCError.Create('could not create window'); + ShowWindow(m_window, m_show); + SetFocus(m_window); + SetActiveWindow(m_window); + SetForegroundWindow(m_window); + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('could not create window', error); + End; +End; + +Procedure TWin32Window.defaults; + +Begin + m_window := 0; + m_event := 0; + m_thread := 0; + m_id := 0; + m_name := ''; + m_title := ''; + m_extra := 0; + m_style := 0; + m_show := 0; + m_x := 0; + m_y := 0; + m_width := 0; + m_height := 0; + m_data := Nil; + m_managed := True; + m_multithreaded := False; +End; + +Procedure TWin32Window.close; + +Begin + If Not m_managed Then + Begin + LOG('detaching from user managed window'); + m_window := 0; + End + Else + Begin + LOG('closing managed window'); + If m_multithreaded Then + Begin + If (m_thread <> 0) And IsWindow(m_window) Then + Begin + PostMessage(m_window, WM_DESTROY, 0, 0); + WaitForSingleObject(m_thread, INFINITE); + End; + If m_event <> 0 Then + CloseHandle(m_event); + If m_thread <> 0 Then + CloseHandle(m_thread); + SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS); + End + Else + If (m_window <> 0) And IsWindow(m_window) Then + DestroyWindow(m_window); + m_window := 0; + m_event := 0; + m_thread := 0; + m_id := 0; + UnregisterClass(PChar(m_name), GetModuleHandle(Nil)); + End; +End; + +Class Procedure TWin32Window.ThreadFunction(owner : TWin32Window); + +Var + message : MSG; + +Begin + With owner Do + Begin + m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data); + If IsWindow(m_window) Then + Begin + ShowWindow(m_window, m_show); + SetFocus(m_window); + SetForegroundWindow(m_window); + SetEvent(m_event); + While GetMessage(message, 0, 0, 0) = True Do + Begin + TranslateMessage(message); + DispatchMessage(message); + End; + End + Else + SetEvent(m_event); + End; +End; diff --git a/packages/ptc/src/win32/base/windowd.inc b/packages/ptc/src/win32/base/windowd.inc new file mode 100644 index 0000000000..d7e7f9d8ae --- /dev/null +++ b/packages/ptc/src/win32/base/windowd.inc @@ -0,0 +1,58 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWin32Window = Class(TObject) + Private + Procedure internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer); + + Procedure defaults; + Procedure close; + Class Procedure ThreadFunction(owner : TWin32Window); +{ Class Function WndProcSingleThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall; + Class Function WndProcMultiThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;} + m_window : HWND; + m_event : THANDLE; + m_thread : THANDLE; + m_id : DWord; + m_name : AnsiString; + m_title : AnsiString; + m_extra : DWord; + m_style : DWord; + m_show : Integer; + m_x, m_y : Integer; + m_width, m_height : Integer; + m_data : Pointer; + m_managed : Boolean; + m_multithreaded : Boolean; + Public + Constructor Create(window : HWND); + Constructor Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer); + Constructor Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean); + Destructor Destroy; Override; + Procedure cursor(flag : Boolean); + Procedure resize(width, height : Integer); + Procedure update(force : Boolean); + Procedure update; {force = False} + Function handle : HWND; + Function thread : DWord; + Function managed : Boolean; + Function multithreaded : Boolean; + End; diff --git a/packages/ptc/src/win32/base/windows.ico b/packages/ptc/src/win32/base/windows.ico Binary files differnew file mode 100644 index 0000000000..3480614b36 --- /dev/null +++ b/packages/ptc/src/win32/base/windows.ico diff --git a/packages/ptc/src/win32/directx/check.inc b/packages/ptc/src/win32/directx/check.inc new file mode 100644 index 0000000000..4414b1e119 --- /dev/null +++ b/packages/ptc/src/win32/directx/check.inc @@ -0,0 +1,142 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Procedure DirectXCheck(result : HRESULT); + +Begin + If result = DD_OK Then + Exit; +{ $IFDEF __PTC_DIRECTX_ERROR_STRINGS__} + Case result Of + DDERR_ALREADYINITIALIZED : Raise TPTCError.Create('DDERR_ALREADYINITIALIZED'); + DDERR_CANNOTATTACHSURFACE : Raise TPTCError.Create('DDERR_CANNOTATTACHSURFACE'); + DDERR_CANNOTDETACHSURFACE : Raise TPTCError.Create('DDERR_CANNOTDETACHSURFACE'); + DDERR_CURRENTLYNOTAVAIL : Raise TPTCError.Create('DDERR_CURRENTLYNOTAVAIL'); + DDERR_EXCEPTION : Raise TPTCError.Create('DDERR_EXCEPTION'); + DDERR_GENERIC : Raise TPTCError.Create('DDERR_GENERIC'); + DDERR_HEIGHTALIGN : Raise TPTCError.Create('DDERR_HEIGHTALIGN'); + DDERR_INCOMPATIBLEPRIMARY : Raise TPTCError.Create('DDERR_INCOMPATIBLEPRIMARY'); + DDERR_INVALIDCAPS : Raise TPTCError.Create('DDERR_INVALIDCAPS'); + DDERR_INVALIDCLIPLIST : Raise TPTCError.Create('DDERR_INVALIDCLIPLIST'); + DDERR_INVALIDMODE : Raise TPTCError.Create('DDERR_INVALIDMODE'); + DDERR_INVALIDOBJECT : Raise TPTCError.Create('DDERR_INVALIDOBJECT'); + DDERR_INVALIDPARAMS : Raise TPTCError.Create('DDERR_INVALIDPARAMS'); + DDERR_INVALIDPIXELFORMAT : Raise TPTCError.Create('DDERR_INVALIDPIXELFORMAT'); + DDERR_INVALIDRECT : Raise TPTCError.Create('DDERR_INVALIDRECT'); + DDERR_LOCKEDSURFACES : Raise TPTCError.Create('DDERR_LOCKEDSURFACES'); + DDERR_NO3D : Raise TPTCError.Create('DDERR_NO3D'); + DDERR_NOALPHAHW : Raise TPTCError.Create('DDERR_NOALPHAHW'); + DDERR_NOCLIPLIST : Raise TPTCError.Create('DDERR_CLIPLIST'); + DDERR_NOCOLORCONVHW : Raise TPTCError.Create('DDERR_NOCOLORCONVHW'); + DDERR_NOCOOPERATIVELEVELSET : Raise TPTCError.Create('DDERR_NOCOOPERATIVELEVELSET'); + DDERR_NOCOLORKEY : Raise TPTCError.Create('DDERR_NOCOLORKEY'); + DDERR_NOCOLORKEYHW : Raise TPTCError.Create('DDERR_NOCOLORKEYHW'); + DDERR_NODIRECTDRAWSUPPORT : Raise TPTCError.Create('DDERR_NODIRECTDRAWSUPPORT'); + DDERR_NOEXCLUSIVEMODE : Raise TPTCError.Create('DDERR_NOEXCLUSIVEMODE'); + DDERR_NOFLIPHW : Raise TPTCError.Create('DDERR_NOFLIPHW'); + DDERR_NOGDI : Raise TPTCError.Create('DDERR_NOGDI'); + DDERR_NOMIRRORHW : Raise TPTCError.Create('DDERR_NOMIRRORHW'); + DDERR_NOTFOUND : Raise TPTCError.Create('DDERR_NOTFOUND'); + DDERR_NOOVERLAYHW : Raise TPTCError.Create('DDERR_NOOVERLAYHW'); + DDERR_NORASTEROPHW : Raise TPTCError.Create('DDERR_NORASTEROPHW'); + DDERR_NOROTATIONHW : Raise TPTCError.Create('DDERR_NOROTATIONHW'); + DDERR_NOSTRETCHHW : Raise TPTCError.Create('DDERR_NOSTRETCHHW'); + DDERR_NOT4BITCOLOR : Raise TPTCError.Create('DDERR_NOT4BITCOLOR'); + DDERR_NOT4BITCOLORINDEX : Raise TPTCError.Create('DDERR_NOT4BITCOLORINDEX'); + DDERR_NOT8BITCOLOR : Raise TPTCError.Create('DDERR_NOT8BITCOLOR'); + DDERR_NOTEXTUREHW : Raise TPTCError.Create('DDERR_NOTEXTUREHW'); + DDERR_NOVSYNCHW : Raise TPTCError.Create('DDERR_NOVSYNCHW'); + DDERR_NOZBUFFERHW : Raise TPTCError.Create('DDERR_NOZBUFFERHW'); + DDERR_NOZOVERLAYHW : Raise TPTCError.Create('DDERR_NOZOVERLAYHW'); + DDERR_OUTOFCAPS : Raise TPTCError.Create('DDERR_OUTOFCAPS'); + DDERR_OUTOFMEMORY : Raise TPTCError.Create('DDERR_OUTOFMEMORY'); + DDERR_OUTOFVIDEOMEMORY : Raise TPTCError.Create('DDERR_OUTOFVIDEOMEMORY'); + DDERR_OVERLAYCANTCLIP : Raise TPTCError.Create('DDERR_OVERLAYCANTCLIP'); + DDERR_OVERLAYCOLORKEYONLYONEACTIVE : Raise TPTCError.Create('DDERR_OVERLAYCOLORKEYONLYONEACTIVE'); + DDERR_PALETTEBUSY : Raise TPTCError.Create('DDERR_PALETTEBUSY'); + DDERR_COLORKEYNOTSET : Raise TPTCError.Create('DDERR_COLORKEYNOTSET'); + DDERR_SURFACEALREADYATTACHED : Raise TPTCError.Create('DDERR_SURFACEALREADYATTACHED'); + DDERR_SURFACEALREADYDEPENDENT : Raise TPTCError.Create('DDERR_SURFACEALREADYDEPENDENT'); + DDERR_SURFACEBUSY : Raise TPTCError.Create('DDERR_SURFACEBUSY'); + DDERR_CANTLOCKSURFACE : Raise TPTCError.Create('DDERR_CANTLOCKSURFACE'); + DDERR_SURFACEISOBSCURED : Raise TPTCError.Create('DDERR_SURFACEISOBSCURED'); + DDERR_SURFACELOST : Raise TPTCError.Create('DDERR_SURFACELOST'); + DDERR_SURFACENOTATTACHED : Raise TPTCError.Create('DDERR_SURFACENOTATTACHED'); + DDERR_TOOBIGHEIGHT : Raise TPTCError.Create('DDERR_TOOBIGHEIGHT'); + DDERR_TOOBIGSIZE : Raise TPTCError.Create('DDERR_TOOBIGSIZE'); + DDERR_TOOBIGWIDTH : Raise TPTCError.Create('DDERR_TOOBIGWIDTH'); + DDERR_UNSUPPORTED : Raise TPTCError.Create('DDERR_UNSUPPORTED'); + DDERR_UNSUPPORTEDFORMAT : Raise TPTCError.Create('DDERR_UNSUPPORTEDFORMAT'); + DDERR_UNSUPPORTEDMASK : Raise TPTCError.Create('DDERR_UNSUPPORTEDMASK'); + DDERR_VERTICALBLANKINPROGRESS : Raise TPTCError.Create('DDERR_VERTICALBLANKINPROGRESS'); + DDERR_WASSTILLDRAWING : Raise TPTCError.Create('DDERR_WASSTILLDRAWING'); + DDERR_XALIGN : Raise TPTCError.Create('DDERR_XALIGN'); + DDERR_INVALIDDIRECTDRAWGUID : Raise TPTCError.Create('DDERR_INVALIDDIRECTDRAWGUID'); + DDERR_DIRECTDRAWALREADYCREATED : Raise TPTCError.Create('DDERR_DIRECTDRAWALREADYCREATED'); + DDERR_NODIRECTDRAWHW : Raise TPTCError.Create('DDERR_NODIRECTDRAWHW'); + DDERR_PRIMARYSURFACEALREADYEXISTS : Raise TPTCError.Create('DDERR_PRIMARYSURFACEALREADYEXISTS'); + DDERR_NOEMULATION : Raise TPTCError.Create('DDERR_NOEMULATION'); + DDERR_REGIONTOOSMALL : Raise TPTCError.Create('DDERR_REGIONTOOSMALL'); + DDERR_CLIPPERISUSINGHWND : Raise TPTCError.Create('DDERR_CLIPPERISUSINGHWND'); + DDERR_NOCLIPPERATTACHED : Raise TPTCError.Create('DDERR_NOCLIPPERATTACHED'); + DDERR_NOHWND : Raise TPTCError.Create('DDERR_NOHWND'); + DDERR_HWNDSUBCLASSED : Raise TPTCError.Create('DDERR_HWNDSUBCLASSED'); + DDERR_HWNDALREADYSET : Raise TPTCError.Create('DDERR_HWNDALREADYSET'); + DDERR_NOPALETTEATTACHED : Raise TPTCError.Create('DDERR_NOPALETTEATTACHED'); + DDERR_NOPALETTEHW : Raise TPTCError.Create('DDERR_NOPALETTEHW'); + DDERR_BLTFASTCANTCLIP : Raise TPTCError.Create('DDERR_BLTFASTCANTCLIP'); + DDERR_NOBLTHW : Raise TPTCError.Create('DDERR_NOBLTHW'); + DDERR_NODDROPSHW : Raise TPTCError.Create('DDERR_NODDROPSHW'); + DDERR_OVERLAYNOTVISIBLE : Raise TPTCError.Create('DDERR_OVERLAYNOTVISIBLE'); + DDERR_NOOVERLAYDEST : Raise TPTCError.Create('DDERR_NOOVERLAYDEST'); + DDERR_INVALIDPOSITION : Raise TPTCError.Create('DDERR_INVALIDPOSITION'); + DDERR_NOTAOVERLAYSURFACE : Raise TPTCError.Create('DDERR_NOTAOVERLAYSURFACE'); + DDERR_EXCLUSIVEMODEALREADYSET : Raise TPTCError.Create('DDERR_EXCLUSIVEMODEALREADYSET'); + DDERR_NOTFLIPPABLE : Raise TPTCError.Create('DDERR_NOTFLIPPABLE'); + DDERR_CANTDUPLICATE : Raise TPTCError.Create('DDERR_CANTDUPLICATE'); + DDERR_NOTLOCKED : Raise TPTCError.Create('DDERR_NOTLOCKED'); + DDERR_CANTCREATEDC : Raise TPTCError.Create('DDERR_CANTCREATEDC'); + DDERR_NODC : Raise TPTCError.Create('DDERR_NODC'); + DDERR_WRONGMODE : Raise TPTCError.Create('DDERR_WRONGMODE'); + DDERR_IMPLICITLYCREATED : Raise TPTCError.Create('DDERR_IMPLICITLYCREATED'); + DDERR_NOTPALETTIZED : Raise TPTCError.Create('DDERR_NOPALETTIZED'); + DDERR_UNSUPPORTEDMODE : Raise TPTCError.Create('DDERR_UNSUPPORTEDMODE'); + DDERR_NOMIPMAPHW : Raise TPTCError.Create('DDERR_NOMIPMAPHW'); + DDERR_INVALIDSURFACETYPE : Raise TPTCError.Create('DDERR_INVALIDSURFACETYPE'); + DDERR_DCALREADYCREATED : Raise TPTCError.Create('DDERR_DCALREADYCREATED'); + DDERR_CANTPAGELOCK : Raise TPTCError.Create('DDERR_CANTPAGELOCK'); + DDERR_CANTPAGEUNLOCK : Raise TPTCError.Create('DDERR_CANTPAGEUNLOCK'); + DDERR_NOTPAGELOCKED : Raise TPTCError.Create('DDERR_NOTPAGELOCKED'); + DDERR_NOTINITIALIZED : Raise TPTCError.Create('DDERR_NOTINITIALIZED'); + End; +{ $ENDIF} + Raise TPTCError.Create('DDERR $' + HexStr(result, 8)); +End; + +Procedure DirectXCheck(result : HRESULT; Const message : String); + +Begin + Try + DirectXCheck(result); + Except + On error : TPTCError Do + Raise TPTCError.Create(message, error); + End; +End; diff --git a/packages/ptc/src/win32/directx/directdr.pp b/packages/ptc/src/win32/directx/directdr.pp new file mode 100644 index 0000000000..bd2942db0e --- /dev/null +++ b/packages/ptc/src/win32/directx/directdr.pp @@ -0,0 +1,1755 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{$MACRO ON} +{$DEFINE DXCall:=StdCall} +{$PACKRECORDS 1} + +Unit DirectDraw; + +Interface + +Uses + Windows; + +Type + LPGUID = ^GUID; + GUID = Packed Record + Data1 : DWord; + Data2 : Word; + Data3 : Word; + Data4 : Array[0..7] Of Byte; + End; + +{; +; FOURCC codes for DX compressed-texture pixel formats +; + +FOURCC_DXT1 = '1TXD' +FOURCC_DXT2 = '2TXD' +FOURCC_DXT3 = '3TXD' +FOURCC_DXT4 = '4TXD' +FOURCC_DXT5 = '5TXD' + +; +; GUIDS used by DirectDraw objects +; + +macro Define_CLSID_DirectDraw +public CLSID_DirectDraw +CLSID_DirectDraw GUID <0D7B70EE0h,04340h,011CFh,\ + 0B0h,063h,000h,020h,0AFh,0C2h,0CDh,035h> +endm + +macro Define_CLSID_DirectDrawClipper +public CLSID_DirectDrawClipper +CLSID_DirectDrawClipper GUID <0593817A0h,07DB3h,011CFh,\ + 0A2h,0DEh,000h,0AAh,000h,0b9h,033h,056h> +endm + +macro Define_IID_IDirectDraw +public IID_IDirectDraw +IID_IDirectDraw GUID <06C14DB80h,0A733h,011CEh,\ + 0A5h,021h,000h,020h,0AFh,00Bh,0E5h,060h> +endm + +macro Define_IID_IDirectDraw2 +public IID_IDirectDraw2 +IID_IDirectDraw2 GUID <0B3A6F3E0h,02B43h,011CFh,\ + 0A2h,0DEh,000h,0AAh,000h,0B9h,033h,056h> +endm + +macro Define_IID_IDirectDraw4 +public IID_IDirectDraw4 +IID_IDirectDraw4 GUID <09c59509ah,039bdh,011d1h,\ + 08ch,04ah,000h,0c0h,04fh,0d9h,030h,0c5h> +endm + +macro Define_IID_IDirectDrawSurface +public IID_IDirectDrawSurface +IID_IDirectDrawSurface GUID <06C14DB81h,0A733h,011CEh,\ + 0A5h,021h,000h,020h,0AFh,00Bh,0E5h,060h> +endm + +macro Define_IID_IDirectDrawSurface2 +public IID_IDirectDrawSurface2 +IID_IDirectDrawSurface2 GUID <057805885h,06eech,011cfh,\ + 094h,041h,0a8h,023h,003h,0c1h,00eh,027h> +endm + +macro Define_IID_IDirectDrawSurface3 +public IID_IDirectDrawSurface3 +IID_IDirectDrawSurface3 GUID <0DA044E00h,069B2h,011D0h,\ + 0A1h,0D5h,000h,0AAh,000h,0B8h,0DFh,0BBh> +endm + +macro Define_IID_IDirectDrawSurface4 +public IID_IDirectDrawSurface4 +IID_IDirectDrawSurface4 GUID <00B2B8630h,0AD35h,011D0h,\ + 08Eh,0A6h,000h,060h,097h,097h,0EAh,05Bh> +endm + +macro Define_IID_IDirectDrawPalette +public IID_IDirectDrawPalette +IID_IDirectDrawPalette GUID <06C14DB84h,0A733h,011CEh,\ + 0A5h,021h,000h,020h,0AFh,00Bh,0E5h,060h> +endm + +macro Define_IID_IDirectDrawClipper +public IID_IDirectDrawClipper +IID_IDirectDrawClipper GUID <06C14DB85h,0A733h,011CEh,\ + 0A5h,021h,000h,020h,0AFh,00Bh,0E5h,060h> +endm + +macro Define_IID_IDirectDrawColorControl +public IID_IDirectDrawColorControl +IID_IDirectDrawColorControl GUID <04B9F0EE0h,00D7Eh,011D0h,\ + 09Bh,006h,000h,0A0h,0C9h,003h,0A3h,0B8h> +endm + +macro Define_IID_IDirectDrawGammaControl +public IID_IDirectDrawGammaControl +IID_IDirectDrawGammaControl GUID <069C11C3Eh,0B46Bh,011D1h,\ + 0ADh,07Ah,000h,0C0h,04Fh,0C2h,09Bh,04Eh> +endm} + +Const + CO_E_NOTINITIALIZED = $800401F0; + _FACDD = $0876; + +{ + Flags for DirectDrawEnumerateEx + DirectDrawEnumerateEx supercedes DirectDrawEnumerate. You must use GetProcAddress to + obtain a function pointer (of type LPDIRECTDRAWENUMERATEEX) to DirectDrawEnumerateEx. + By default, only the primary display device is enumerated. + DirectDrawEnumerate is equivalent to DirectDrawEnumerate(,,DDENUM_NONDISPLAYDEVICES) +} + + DDENUM_ATTACHEDSECONDARYDEVICES = $00000001; + DDENUM_DETACHEDSECONDARYDEVICES = $00000002; + DDENUM_NONDISPLAYDEVICES = $00000004; + +{REGSTR_KEY_DDHW_DESCRIPTION equ <'Description', 0> +REGSTR_KEY_DDHW_DRIVERNAME equ <'DriverName', 0> +REGSTR_PATH_DDHW equ <'Hardware\DirectDrawDrivers', 0>} + + DDCREATE_HARDWAREONLY = $00000001; + DDCREATE_EMULATIONONLY = $00000002; + +{proctype DDENUMMODESCALLBACK :dword, :dword +proctype DDENUMMODESCALLBACK2 :dword, :dword +proctype DDENUMSURFACESCALLBACK :dword, :dword, :dword +proctype DDENUMSURFACESCALLBACK2 :dword, :dword, :dword} + + DD_ROP_SPACE = (256 Div 32); {space required to store ROP array} + + DDSD_CAPS = $00000001; {default} + DDSD_HEIGHT = $00000002; + DDSD_WIDTH = $00000004; + DDSD_PITCH = $00000008; + DDSD_BACKBUFFERCOUNT = $00000020; + DDSD_ZBUFFERBITDEPTH = $00000040; + DDSD_ALPHABITDEPTH = $00000080; + DDSD_LPSURFACE = $00000800; + DDSD_PIXELFORMAT = $00001000; + DDSD_CKDESTOVERLAY = $00002000; + DDSD_CKDESTBLT = $00004000; + DDSD_CKSRCOVERLAY = $00008000; + DDSD_CKSRCBLT = $00010000; + DDSD_MIPMAPCOUNT = $00020000; + DDSD_REFRESHRATE = $00040000; + DDSD_LINEARSIZE = $00080000; + DDSD_TEXTURESTAGE = $00100000; + DDSD_ALL = $001ff9ee; + + DDOSD_GUID = $00000001; + DDOSD_COMPRESSION_RATIO = $00000002; + DDOSD_SCAPS = $00000004; + DDOSD_OSCAPS = $00000008; + DDOSD_ALL = $0000000f; + DDOSDCAPS_OPTCOMPRESSED = $00000001; + DDOSDCAPS_OPTREORDERED = $00000002; + DDOSDCAPS_MONOLITHICMIPMAP = $00000004; + DDOSDCAPS_VALIDSCAPS = $30004800; + DDOSDCAPS_VALIDOSCAPS = $00000007; + + DDCOLOR_BRIGHTNESS = $00000001; + DDCOLOR_CONTRAST = $00000002; + DDCOLOR_HUE = $00000004; + DDCOLOR_SATURATION = $00000008; + DDCOLOR_SHARPNESS = $00000010; + DDCOLOR_GAMMA = $00000020; + DDCOLOR_COLORENABLE = $00000040; + +{============================================================================ + + Direct Draw Capability Flags + + These flags are used to describe the capabilities of a given Surface. + All flags are bit flags. + + ==========================================================================} + +{*************************************************************************** + * + * DIRECTDRAWSURFACE CAPABILITY FLAGS + * + ***************************************************************************} + + + DDSCAPS_RESERVED1 = $00000001; + DDSCAPS_ALPHA = $00000002; + DDSCAPS_BACKBUFFER = $00000004; + DDSCAPS_COMPLEX = $00000008; + DDSCAPS_FLIP = $00000010; + DDSCAPS_FRONTBUFFER = $00000020; + DDSCAPS_OFFSCREENPLAIN = $00000040; + DDSCAPS_OVERLAY = $00000080; + DDSCAPS_PALETTE = $00000100; + DDSCAPS_PRIMARYSURFACE = $00000200; + DDSCAPS_PRIMARYSURFACELEFT = $00000400; + DDSCAPS_SYSTEMMEMORY = $00000800; + DDSCAPS_TEXTURE = $00001000; + DDSCAPS_3DDEVICE = $00002000; + DDSCAPS_VIDEOMEMORY = $00004000; + DDSCAPS_VISIBLE = $00008000; + DDSCAPS_WRITEONLY = $00010000; + DDSCAPS_ZBUFFER = $00020000; + DDSCAPS_OWNDC = $00040000; + DDSCAPS_LIVEVIDEO = $00080000; + DDSCAPS_HWCODEC = $00100000; + DDSCAPS_MODEX = $00200000; + DDSCAPS_MIPMAP = $00400000; + DDSCAPS_RESERVED2 = $00800000; + DDSCAPS_ALLOCONLOAD = $04000000; + DDSCAPS_VIDEOPORT = $08000000; + DDSCAPS_LOCALVIDMEM = $10000000; + DDSCAPS_NONLOCALVIDMEM = $20000000; + DDSCAPS_STANDARDVGAMODE = $40000000; + DDSCAPS_OPTIMIZED = $80000000; + + DDSCAPS2_HARDWAREDEINTERLACE = $00000002; + DDSCAPS2_HINTDYNAMIC = $00000004; + DDSCAPS2_HINTSTATIC = $00000008; + DDSCAPS2_TEXTUREMANAGE = $00000010; + DDSCAPS2_RESERVED1 = $00000020; + DDSCAPS2_RESERVED2 = $00000040; + DDSCAPS2_OPAQUE = $00000080; + DDSCAPS2_HINTANTIALIASING = $00000100; + +{*************************************************************************** + * + * DIRECTDRAW DRIVER CAPABILITY FLAGS + * + ***************************************************************************} + + DDCAPS_3D = $00000001; + DDCAPS_ALIGNBOUNDARYDEST = $00000002; + DDCAPS_ALIGNSIZEDEST = $00000004; + DDCAPS_ALIGNBOUNDARYSRC = $00000008; + DDCAPS_ALIGNSIZESRC = $00000010; + DDCAPS_ALIGNSTRIDE = $00000020; + DDCAPS_BLT = $00000040; + DDCAPS_BLTQUEUE = $00000080; + DDCAPS_BLTFOURCC = $00000100; + DDCAPS_BLTSTRETCH = $00000200; + DDCAPS_GDI = $00000400; + DDCAPS_OVERLAY = $00000800; + DDCAPS_OVERLAYCANTCLIP = $00001000; + DDCAPS_OVERLAYFOURCC = $00002000; + DDCAPS_OVERLAYSTRETCH = $00004000; + DDCAPS_PALETTE = $00008000; + DDCAPS_PALETTEVSYNC = $00010000; + DDCAPS_READSCANLINE = $00020000; + DDCAPS_STEREOVIEW = $00040000; + DDCAPS_VBI = $00080000; + DDCAPS_ZBLTS = $00100000; + DDCAPS_ZOVERLAYS = $00200000; + DDCAPS_COLORKEY = $00400000; + DDCAPS_ALPHA = $00800000; + DDCAPS_COLORKEYHWASSIST = $01000000; + DDCAPS_NOHARDWARE = $02000000; + DDCAPS_BLTCOLORFILL = $04000000; + DDCAPS_BANKSWITCHED = $08000000; + DDCAPS_BLTDEPTHFILL = $10000000; + DDCAPS_CANCLIP = $20000000; + DDCAPS_CANCLIPSTRETCHED = $40000000; + DDCAPS_CANBLTSYSMEM = $80000000; + +{*************************************************************************** + * + * MORE DIRECTDRAW DRIVER CAPABILITY FLAGS (dwCaps2) + * + ***************************************************************************} + + DDCAPS2_CERTIFIED = $00000001; + DDCAPS2_NO2DDURING3DSCENE = $00000002; + DDCAPS2_VIDEOPORT = $00000004; + DDCAPS2_AUTOFLIPOVERLAY = $00000008; + DDCAPS2_CANBOBINTERLEAVED = $00000010; + DDCAPS2_CANBOBNONINTERLEAVED = $00000020; + DDCAPS2_COLORCONTROLOVERLAY = $00000040; + DDCAPS2_COLORCONTROLPRIMARY = $00000080; + DDCAPS2_CANDROPZ16BIT = $00000100; + DDCAPS2_NONLOCALVIDMEM = $00000200; + DDCAPS2_NONLOCALVIDMEMCAPS = $00000400; + DDCAPS2_NOPAGELOCKREQUIRED = $00000800; + DDCAPS2_WIDESURFACES = $00001000; + DDCAPS2_CANFLIPODDEVEN = $00002000; + DDCAPS2_CANBOBHARDWARE = $00004000; + DDCAPS2_COPYFOURCC = $00008000; + DDCAPS2_PRIMARYGAMMA = $00020000; + DDCAPS2_CANRENDERWINDOWED = $00080000; + DDCAPS2_CANCALIBRATEGAMMA = $00100000; + DDCAPS2_FLIPINTERVAL = $00200000; + DDCAPS2_FLIPNOVSYNC = $00400000; + +{*************************************************************************** + * + * DIRECTDRAW FX ALPHA CAPABILITY FLAGS + * + ***************************************************************************} + + DDFXALPHACAPS_BLTALPHAEDGEBLEND = $00000001; + DDFXALPHACAPS_BLTALPHAPIXELS = $00000002; + DDFXALPHACAPS_BLTALPHAPIXELSNEG = $00000004; + DDFXALPHACAPS_BLTALPHASURFACES = $00000008; + DDFXALPHACAPS_BLTALPHASURFACESNEG = $00000010; + DDFXALPHACAPS_OVERLAYALPHAEDGEBLEND = $00000020; + DDFXALPHACAPS_OVERLAYALPHAPIXELS = $00000040; + DDFXALPHACAPS_OVERLAYALPHAPIXELSNEG = $00000080; + DDFXALPHACAPS_OVERLAYALPHASURFACES = $00000100; + DDFXALPHACAPS_OVERLAYALPHASURFACESNEG = $00000200; + +{*************************************************************************** + * + * DIRECTDRAW FX CAPABILITY FLAGS + * + ***************************************************************************} + + DDFXCAPS_BLTARITHSTRETCHY = $00000020; + DDFXCAPS_BLTARITHSTRETCHYN = $00000010; + DDFXCAPS_BLTMIRRORLEFTRIGHT = $00000040; + DDFXCAPS_BLTMIRRORUPDOWN = $00000080; + DDFXCAPS_BLTROTATION = $00000100; + DDFXCAPS_BLTROTATION90 = $00000200; + DDFXCAPS_BLTSHRINKX = $00000400; + DDFXCAPS_BLTSHRINKXN = $00000800; + DDFXCAPS_BLTSHRINKY = $00001000; + DDFXCAPS_BLTSHRINKYN = $00002000; + DDFXCAPS_BLTSTRETCHX = $00004000; + DDFXCAPS_BLTSTRETCHXN = $00008000; + DDFXCAPS_BLTSTRETCHY = $00010000; + DDFXCAPS_BLTSTRETCHYN = $00020000; + DDFXCAPS_OVERLAYARITHSTRETCHY = $00040000; + DDFXCAPS_OVERLAYARITHSTRETCHYN = $00000008; + DDFXCAPS_OVERLAYSHRINKX = $00080000; + DDFXCAPS_OVERLAYSHRINKXN = $00100000; + DDFXCAPS_OVERLAYSHRINKY = $00200000; + DDFXCAPS_OVERLAYSHRINKYN = $00400000; + DDFXCAPS_OVERLAYSTRETCHX = $00800000; + DDFXCAPS_OVERLAYSTRETCHXN = $01000000; + DDFXCAPS_OVERLAYSTRETCHY = $02000000; + DDFXCAPS_OVERLAYSTRETCHYN = $04000000; + DDFXCAPS_OVERLAYMIRRORLEFTRIGHT = $08000000; + DDFXCAPS_OVERLAYMIRRORUPDOWN = $10000000; + DDFXCAPS_BLTALPHA = $00000001; + DDFXCAPS_BLTTRANSFORM = $00000002; + DDFXCAPS_BLTFILTER = DDFXCAPS_BLTARITHSTRETCHY; + DDFXCAPS_OVERLAYALPHA = $00000004; + DDFXCAPS_OVERLAYTRANSFORM = $20000000; + DDFXCAPS_OVERLAYFILTER = DDFXCAPS_OVERLAYARITHSTRETCHY; + +{*************************************************************************** + * + * DIRECTDRAW STEREO VIEW CAPABILITIES + * + ***************************************************************************} + + DDSVCAPS_ENIGMA = $00000001; + DDSVCAPS_FLICKER = $00000002; + DDSVCAPS_REDBLUE = $00000004; + DDSVCAPS_SPLIT = $00000008; + +{*************************************************************************** + * + * DIRECTDRAWPALETTE CAPABILITIES + * + ***************************************************************************} + + DDPCAPS_4BIT = $00000001; + DDPCAPS_8BITENTRIES = $00000002; + DDPCAPS_8BIT = $00000004; + DDPCAPS_INITIALIZE = $00000008; + DDPCAPS_PRIMARYSURFACE = $00000010; + DDPCAPS_PRIMARYSURFACELEFT = $00000020; + DDPCAPS_ALLOW256 = $00000040; + DDPCAPS_VSYNC = $00000080; + DDPCAPS_1BIT = $00000100; + DDPCAPS_2BIT = $00000200; + DDPCAPS_ALPHA = $00000400; + +{*************************************************************************** + * + * DIRECTDRAWSURFACE SETPRIVATEDATA CONSTANTS + * + ***************************************************************************} + + DDSPD_IUNKNOWNPOINTER = $00000001; + DDSPD_VOLATILE = $00000002; + +{*************************************************************************** + * + * DIRECTDRAW BITDEPTH CONSTANTS + * + * NOTE: These are only used to indicate supported bit depths. These + * are flags only, they are not to be used as an actual bit depth. The + * absolute numbers 1, 2, 4, 8, 16, 24 and 32 are used to indicate actual + * bit depths in a surface or for changing the display mode. + * + ***************************************************************************} + + DDBD_1 = $00004000; + DDBD_2 = $00002000; + DDBD_4 = $00001000; + DDBD_8 = $00000800; + DDBD_16 = $00000400; + DDBD_24 = $00000200; + DDBD_32 = $00000100; + +{*************************************************************************** + * + * DIRECTDRAWSURFACE SET/GET COLOR KEY FLAGS + * + ***************************************************************************} + + DDCKEY_COLORSPACE = $00000001; + DDCKEY_DESTBLT = $00000002; + DDCKEY_DESTOVERLAY = $00000004; + DDCKEY_SRCBLT = $00000008; + DDCKEY_SRCOVERLAY = $00000010; + +{*************************************************************************** + * + * DIRECTDRAW COLOR KEY CAPABILITY FLAGS + * + ***************************************************************************} + +DDCKEYCAPS_DESTBLT = $00000001; +DDCKEYCAPS_DESTBLTCLRSPACE = $00000002; +DDCKEYCAPS_DESTBLTCLRSPACEYUV = $00000004; +DDCKEYCAPS_DESTBLTYUV = $00000008; +DDCKEYCAPS_DESTOVERLAY = $00000010; +DDCKEYCAPS_DESTOVERLAYCLRSPACE = $00000020; +DDCKEYCAPS_DESTOVERLAYCLRSPACEYUV = $00000040; +DDCKEYCAPS_DESTOVERLAYONEACTIVE = $00000080; +DDCKEYCAPS_DESTOVERLAYYUV = $00000100; +DDCKEYCAPS_SRCBLT = $00000200; +DDCKEYCAPS_SRCBLTCLRSPACE = $00000400; +DDCKEYCAPS_SRCBLTCLRSPACEYUV = $00000800; +DDCKEYCAPS_SRCBLTYUV = $00001000; +DDCKEYCAPS_SRCOVERLAY = $00002000; +DDCKEYCAPS_SRCOVERLAYCLRSPACE = $00004000; +DDCKEYCAPS_SRCOVERLAYCLRSPACEYUV = $00008000; +DDCKEYCAPS_SRCOVERLAYONEACTIVE = $00010000; +DDCKEYCAPS_SRCOVERLAYYUV = $00020000; +DDCKEYCAPS_NOCOSTOVERLAY = $00040000; + +{*************************************************************************** + * + * DIRECTDRAW PIXELFORMAT FLAGS + * + ***************************************************************************} + + DDPF_ALPHAPIXELS = $00000001; + DDPF_ALPHA = $00000002; + DDPF_FOURCC = $00000004; + DDPF_PALETTEINDEXED4 = $00000008; + DDPF_PALETTEINDEXEDTO8 = $00000010; + DDPF_PALETTEINDEXED8 = $00000020; + DDPF_RGB = $00000040; + DDPF_COMPRESSED = $00000080; + DDPF_RGBTOYUV = $00000100; + DDPF_YUV = $00000200; + DDPF_ZBUFFER = $00000400; + DDPF_PALETTEINDEXED1 = $00000800; + DDPF_PALETTEINDEXED2 = $00001000; + DDPF_ZPIXELS = $00002000; + DDPF_STENCILBUFFER = $00004000; + DDPF_ALPHAPREMULT = $00008000; + DDPF_LUMINANCE = $00020000; + DDPF_BUMPLUMINANCE = $00040000; + DDPF_BUMPDUDV = $00080000; + +{=========================================================================== + + + DIRECTDRAW CALLBACK FLAGS + + + ===========================================================================} + +{*************************************************************************** + * + * DIRECTDRAW ENUMSURFACES FLAGS + * + ***************************************************************************} + + DDENUMSURFACES_ALL = $00000001; + DDENUMSURFACES_MATCH = $00000002; + DDENUMSURFACES_NOMATCH = $00000004; + DDENUMSURFACES_CANBECREATED = $00000008; + DDENUMSURFACES_DOESEXIST = $00000010; + +{*************************************************************************** + * + * DIRECTDRAW SETDISPLAYMODE FLAGS + * + ***************************************************************************} + + DDSDM_STANDARDVGAMODE = $00000001; + + +{*************************************************************************** + * + * DIRECTDRAW ENUMDISPLAYMODES FLAGS + * + ***************************************************************************} + +DDEDM_REFRESHRATES = $00000001; +DDEDM_STANDARDVGAMODES = $00000002; + +{*************************************************************************** + * + * DIRECTDRAW SETCOOPERATIVELEVEL FLAGS + * + ***************************************************************************} + + DDSCL_FULLSCREEN = $00000001; + DDSCL_ALLOWREBOOT = $00000002; + DDSCL_NOWINDOWCHANGES = $00000004; + DDSCL_NORMAL = $00000008; + DDSCL_EXCLUSIVE = $00000010; + DDSCL_ALLOWMODEX = $00000040; + DDSCL_SETFOCUSWINDOW = $00000080; + DDSCL_SETDEVICEWINDOW = $00000100; + DDSCL_CREATEDEVICEWINDOW = $00000200; + DDSCL_MULTITHREADED = $00000400; + DDSCL_FPUSETUP = $00000800; + +{*************************************************************************** + * + * DIRECTDRAW BLT FLAGS + * + ***************************************************************************} + + DDBLT_ALPHADEST = $00000001; + DDBLT_ALPHADESTCONSTOVERRIDE = $00000002; + DDBLT_ALPHADESTNEG = $00000004; + DDBLT_ALPHADESTSURFACEOVERRIDE = $00000008; + DDBLT_ALPHAEDGEBLEND = $00000010; + DDBLT_ALPHASRC = $00000020; + DDBLT_ALPHASRCCONSTOVERRIDE = $00000040; + DDBLT_ALPHASRCNEG = $00000080; + DDBLT_ALPHASRCSURFACEOVERRIDE = $00000100; + DDBLT_ASYNC = $00000200; + DDBLT_COLORFILL = $00000400; + DDBLT_DDFX = $00000800; + DDBLT_DDROPS = $00001000; + DDBLT_KEYDEST = $00002000; + DDBLT_KEYDESTOVERRIDE = $00004000; + DDBLT_KEYSRC = $00008000; + DDBLT_KEYSRCOVERRIDE = $00010000; + DDBLT_ROP = $00020000; + DDBLT_ROTATIONANGLE = $00040000; + DDBLT_ZBUFFER = $00080000; + DDBLT_ZBUFFERDESTCONSTOVERRIDE = $00100000; + DDBLT_ZBUFFERDESTOVERRIDE = $00200000; + DDBLT_ZBUFFERSRCCONSTOVERRIDE = $00400000; + DDBLT_ZBUFFERSRCOVERRIDE = $00800000; + DDBLT_WAIT = $01000000; + DDBLT_DEPTHFILL = $02000000; + +{*************************************************************************** + * + * BLTFAST FLAGS + * + ***************************************************************************} + + DDBLTFAST_NOCOLORKEY = $00000000; + DDBLTFAST_SRCCOLORKEY = $00000001; + DDBLTFAST_DESTCOLORKEY = $00000002; + DDBLTFAST_WAIT = $00000010; + +{*************************************************************************** + * + * FLIP FLAGS + * + ***************************************************************************} + + DDFLIP_WAIT = $00000001; + DDFLIP_EVEN = $00000002; + DDFLIP_ODD = $00000004; + DDFLIP_NOVSYNC = $00000008; + DDFLIP_INTERVAL2 = $02000000; + DDFLIP_INTERVAL3 = $03000000; + DDFLIP_INTERVAL4 = $04000000; + +{*************************************************************************** + * + * DIRECTDRAW SURFACE OVERLAY FLAGS + * + ***************************************************************************} + + DDOVER_ALPHADEST = $00000001; + DDOVER_ALPHADESTCONSTOVERRIDE = $00000002; + DDOVER_ALPHADESTNEG = $00000004; + DDOVER_ALPHADESTSURFACEOVERRIDE = $00000008; + DDOVER_ALPHAEDGEBLEND = $00000010; + DDOVER_ALPHASRC = $00000020; + DDOVER_ALPHASRCCONSTOVERRIDE = $00000040; + DDOVER_ALPHASRCNEG = $00000080; + DDOVER_ALPHASRCSURFACEOVERRIDE = $00000100; + DDOVER_HIDE = $00000200; + DDOVER_KEYDEST = $00000400; + DDOVER_KEYDESTOVERRIDE = $00000800; + DDOVER_KEYSRC = $00001000; + DDOVER_KEYSRCOVERRIDE = $00002000; + DDOVER_SHOW = $00004000; + DDOVER_ADDDIRTYRECT = $00008000; + DDOVER_REFRESHDIRTYRECTS = $00010000; + DDOVER_REFRESHALL = $00020000; + DDOVER_DDFX = $00080000; + DDOVER_AUTOFLIP = $00100000; + DDOVER_BOB = $00200000; + DDOVER_OVERRIDEBOBWEAVE = $00400000; + DDOVER_INTERLEAVED = $00800000; + DDOVER_BOBHARDWARE = $01000000; + +{*************************************************************************** + * + * DIRECTDRAWSURFACE LOCK FLAGS + * + ***************************************************************************} + + DDLOCK_SURFACEMEMORYPTR = $00000000; {default} + DDLOCK_WAIT = $00000001; + DDLOCK_EVENT = $00000002; + DDLOCK_READONLY = $00000010; + DDLOCK_WRITEONLY = $00000020; + DDLOCK_NOSYSLOCK = $00000800; + +{*************************************************************************** + * + * DIRECTDRAWSURFACE BLT FX FLAGS + * + ***************************************************************************} + +DDBLTFX_ARITHSTRETCHY = $00000001; +DDBLTFX_MIRRORLEFTRIGHT = $00000002; +DDBLTFX_MIRRORUPDOWN = $00000004; +DDBLTFX_NOTEARING = $00000008; +DDBLTFX_ROTATE180 = $00000010; +DDBLTFX_ROTATE270 = $00000020; +DDBLTFX_ROTATE90 = $00000040; +DDBLTFX_ZBUFFERRANGE = $00000080; +DDBLTFX_ZBUFFERBASEDEST = $00000100; + +{*************************************************************************** + * + * DIRECTDRAWSURFACE OVERLAY FX FLAGS + * + ***************************************************************************} + + DDOVERFX_ARITHSTRETCHY = $00000001; + DDOVERFX_MIRRORLEFTRIGHT = $00000002; + DDOVERFX_MIRRORUPDOWN = $00000004; + +{*************************************************************************** + * + * Flags for dwDDFX member of DDSPRITEFX structure + * + ***************************************************************************} + + DDSPRITEFX_AFFINETRANSFORM = $00000001; + DDSPRITEFX_RGBASCALING = $00000002; + DDSPRITEFX_DEGRADERGBASCALING = $00000004; + DDSPRITEFX_BILINEARFILTER = $00000008; + DDSPRITEFX_BLURFILTER = $00000010; + DDSPRITEFX_FLATFILTER = $00000020; + DDSPRITEFX_DEGRADEFILTER = $00000040; + +{*************************************************************************** + * + * DIRECTDRAW WAITFORVERTICALBLANK FLAGS + * + ***************************************************************************} + + DDWAITVB_BLOCKBEGIN = $00000001; + DDWAITVB_BLOCKBEGINEVENT = $00000002; + DDWAITVB_BLOCKEND = $00000004; + +{*************************************************************************** + * + * DIRECTDRAW GETFLIPSTATUS FLAGS + * + ***************************************************************************} + + DDGFS_CANFLIP = $00000001; + DDGFS_ISFLIPDONE = $00000002; + +{*************************************************************************** + * + * DIRECTDRAW GETBLTSTATUS FLAGS + * + ***************************************************************************} + + DDGBS_CANBLT = $00000001; + DDGBS_ISBLTDONE = $00000002; + +{*************************************************************************** + * + * DIRECTDRAW ENUMOVERLAYZORDER FLAGS + * + ***************************************************************************} + + DDENUMOVERLAYZ_BACKTOFRONT = $00000000; + DDENUMOVERLAYZ_FRONTTOBACK = $00000001; + +{*************************************************************************** + * + * DIRECTDRAW UPDATEOVERLAYZORDER FLAGS + * + ***************************************************************************} + + DDOVERZ_SENDTOFRONT = $00000000; + DDOVERZ_SENDTOBACK = $00000001; + DDOVERZ_MOVEFORWARD = $00000002; + DDOVERZ_MOVEBACKWARD = $00000003; + DDOVERZ_INSERTINFRONTOF = $00000004; + DDOVERZ_INSERTINBACKOF = $00000005; + + +{*************************************************************************** + * + * DIRECTDRAW SETGAMMARAMP FLAGS + * + ***************************************************************************} + + DDSGR_CALIBRATE = $00000001; + + +{=========================================================================== + + + DIRECTDRAW RETURN CODES + + The return values from DirectDraw Commands and Surface that return an HRESULT + are codes from DirectDraw concerning the results of the action + requested by DirectDraw. + + ===========================================================================} + + DD_OK = 0; + DD_FALSE = S_FALSE; + +{*************************************************************************** + * + * DIRECTDRAW ENUMCALLBACK RETURN VALUES + * + * EnumCallback returns are used to control the flow of the DIRECTDRAW and + * DIRECTDRAWSURFACE object enumerations. They can only be returned by + * enumeration callback routines. + * + ***************************************************************************} + + DDENUMRET_CANCEL = 0; + DDENUMRET_OK = 1; + +{*************************************************************************** + * + * DIRECTDRAW ERRORS + * + * Errors are represented by negative values and cannot be combined. + * + ***************************************************************************} + + DDERR_ALREADYINITIALIZED = ($80000000 + (_FACDD Shl 16) + 5); + DDERR_CANNOTATTACHSURFACE = ($80000000 + (_FACDD Shl 16) + 10); + DDERR_CANNOTDETACHSURFACE = ($80000000 + (_FACDD Shl 16) + 20); + DDERR_CURRENTLYNOTAVAIL = ($80000000 + (_FACDD Shl 16) + 40); + DDERR_EXCEPTION = ($80000000 + (_FACDD Shl 16) + 55); + DDERR_GENERIC = E_FAIL; + DDERR_HEIGHTALIGN = ($80000000 + (_FACDD Shl 16) + 90); + DDERR_INCOMPATIBLEPRIMARY = ($80000000 + (_FACDD Shl 16) + 95); + DDERR_INVALIDCAPS = ($80000000 + (_FACDD Shl 16) + 100); + DDERR_INVALIDCLIPLIST = ($80000000 + (_FACDD Shl 16) + 110); + DDERR_INVALIDMODE = ($80000000 + (_FACDD Shl 16) + 120); + DDERR_INVALIDOBJECT = ($80000000 + (_FACDD Shl 16) + 130); + DDERR_INVALIDPARAMS = E_INVALIDARG; + DDERR_INVALIDPIXELFORMAT = ($80000000 + (_FACDD Shl 16) + 145); + DDERR_INVALIDRECT = ($80000000 + (_FACDD Shl 16) + 150); + DDERR_LOCKEDSURFACES = ($80000000 + (_FACDD Shl 16) + 160); + DDERR_NO3D = ($80000000 + (_FACDD Shl 16) + 170); + DDERR_NOALPHAHW = ($80000000 + (_FACDD Shl 16) + 180); + DDERR_NOCLIPLIST = ($80000000 + (_FACDD Shl 16) + 205); + DDERR_NOCOLORCONVHW = ($80000000 + (_FACDD Shl 16) + 210); + DDERR_NOCOOPERATIVELEVELSET = ($80000000 + (_FACDD Shl 16) + 212); + DDERR_NOCOLORKEY = ($80000000 + (_FACDD Shl 16) + 215); + DDERR_NOCOLORKEYHW = ($80000000 + (_FACDD Shl 16) + 220); + DDERR_NODIRECTDRAWSUPPORT = ($80000000 + (_FACDD Shl 16) + 222); + DDERR_NOEXCLUSIVEMODE = ($80000000 + (_FACDD Shl 16) + 225); + DDERR_NOFLIPHW = ($80000000 + (_FACDD Shl 16) + 230); + DDERR_NOGDI = ($80000000 + (_FACDD Shl 16) + 240); + DDERR_NOMIRRORHW = ($80000000 + (_FACDD Shl 16) + 250); + DDERR_NOTFOUND = ($80000000 + (_FACDD Shl 16) + 255); + DDERR_NOOVERLAYHW = ($80000000 + (_FACDD Shl 16) + 260); + DDERR_OVERLAPPINGRECTS = ($80000000 + (_FACDD Shl 16) + 270); + DDERR_NORASTEROPHW = ($80000000 + (_FACDD Shl 16) + 280); + DDERR_NOROTATIONHW = ($80000000 + (_FACDD Shl 16) + 290); + DDERR_NOSTRETCHHW = ($80000000 + (_FACDD Shl 16) + 310); + DDERR_NOT4BITCOLOR = ($80000000 + (_FACDD Shl 16) + 316); + DDERR_NOT4BITCOLORINDEX = ($80000000 + (_FACDD Shl 16) + 317); + DDERR_NOT8BITCOLOR = ($80000000 + (_FACDD Shl 16) + 320); + DDERR_NOTEXTUREHW = ($80000000 + (_FACDD Shl 16) + 330); + DDERR_NOVSYNCHW = ($80000000 + (_FACDD Shl 16) + 335); + DDERR_NOZBUFFERHW = ($80000000 + (_FACDD Shl 16) + 340); + DDERR_NOZOVERLAYHW = ($80000000 + (_FACDD Shl 16) + 350); + DDERR_OUTOFCAPS = ($80000000 + (_FACDD Shl 16) + 360); + DDERR_OUTOFMEMORY = E_OUTOFMEMORY; + DDERR_OUTOFVIDEOMEMORY = ($80000000 + (_FACDD Shl 16) + 380); + DDERR_OVERLAYCANTCLIP = ($80000000 + (_FACDD Shl 16) + 382); + DDERR_OVERLAYCOLORKEYONLYONEACTIVE = ($80000000 + (_FACDD Shl 16) + 384); + DDERR_PALETTEBUSY = ($80000000 + (_FACDD Shl 16) + 387); + DDERR_COLORKEYNOTSET = ($80000000 + (_FACDD Shl 16) + 400); + DDERR_SURFACEALREADYATTACHED = ($80000000 + (_FACDD Shl 16) + 410); + DDERR_SURFACEALREADYDEPENDENT = ($80000000 + (_FACDD Shl 16) + 420); + DDERR_SURFACEBUSY = ($80000000 + (_FACDD Shl 16) + 430); + DDERR_CANTLOCKSURFACE = ($80000000 + (_FACDD Shl 16) + 435); + DDERR_SURFACEISOBSCURED = ($80000000 + (_FACDD Shl 16) + 440); + DDERR_SURFACELOST = ($80000000 + (_FACDD Shl 16) + 450); + DDERR_SURFACENOTATTACHED = ($80000000 + (_FACDD Shl 16) + 460); + DDERR_TOOBIGHEIGHT = ($80000000 + (_FACDD Shl 16) + 470); + DDERR_TOOBIGSIZE = ($80000000 + (_FACDD Shl 16) + 480); + DDERR_TOOBIGWIDTH = ($80000000 + (_FACDD Shl 16) + 490); + DDERR_UNSUPPORTED = E_NOTIMPL; + DDERR_UNSUPPORTEDFORMAT = ($80000000 + (_FACDD Shl 16) + 510); + DDERR_UNSUPPORTEDMASK = ($80000000 + (_FACDD Shl 16) + 520); + DDERR_INVALIDSTREAM = ($80000000 + (_FACDD Shl 16) + 521); + DDERR_VERTICALBLANKINPROGRESS = ($80000000 + (_FACDD Shl 16) + 537); + DDERR_WASSTILLDRAWING = ($80000000 + (_FACDD Shl 16) + 540); + DDERR_XALIGN = ($80000000 + (_FACDD Shl 16) + 560); + DDERR_INVALIDDIRECTDRAWGUID = ($80000000 + (_FACDD Shl 16) + 561); + DDERR_DIRECTDRAWALREADYCREATED = ($80000000 + (_FACDD Shl 16) + 562); + DDERR_NODIRECTDRAWHW = ($80000000 + (_FACDD Shl 16) + 563); + DDERR_PRIMARYSURFACEALREADYEXISTS = ($80000000 + (_FACDD Shl 16) + 564); + DDERR_NOEMULATION = ($80000000 + (_FACDD Shl 16) + 565); + DDERR_REGIONTOOSMALL = ($80000000 + (_FACDD Shl 16) + 566); + DDERR_CLIPPERISUSINGHWND = ($80000000 + (_FACDD Shl 16) + 567); + DDERR_NOCLIPPERATTACHED = ($80000000 + (_FACDD Shl 16) + 568); + DDERR_NOHWND = ($80000000 + (_FACDD Shl 16) + 569); + DDERR_HWNDSUBCLASSED = ($80000000 + (_FACDD Shl 16) + 570); + DDERR_HWNDALREADYSET = ($80000000 + (_FACDD Shl 16) + 571); + DDERR_NOPALETTEATTACHED = ($80000000 + (_FACDD Shl 16) + 572); + DDERR_NOPALETTEHW = ($80000000 + (_FACDD Shl 16) + 573); + DDERR_BLTFASTCANTCLIP = ($80000000 + (_FACDD Shl 16) + 574); + DDERR_NOBLTHW = ($80000000 + (_FACDD Shl 16) + 575); + DDERR_NODDROPSHW = ($80000000 + (_FACDD Shl 16) + 576); + DDERR_OVERLAYNOTVISIBLE = ($80000000 + (_FACDD Shl 16) + 577); + DDERR_NOOVERLAYDEST = ($80000000 + (_FACDD Shl 16) + 578); + DDERR_INVALIDPOSITION = ($80000000 + (_FACDD Shl 16) + 579); + DDERR_NOTAOVERLAYSURFACE = ($80000000 + (_FACDD Shl 16) + 580); + DDERR_EXCLUSIVEMODEALREADYSET = ($80000000 + (_FACDD Shl 16) + 581); + DDERR_NOTFLIPPABLE = ($80000000 + (_FACDD Shl 16) + 582); + DDERR_CANTDUPLICATE = ($80000000 + (_FACDD Shl 16) + 583); + DDERR_NOTLOCKED = ($80000000 + (_FACDD Shl 16) + 584); + DDERR_CANTCREATEDC = ($80000000 + (_FACDD Shl 16) + 585); + DDERR_NODC = ($80000000 + (_FACDD Shl 16) + 586); + DDERR_WRONGMODE = ($80000000 + (_FACDD Shl 16) + 587); + DDERR_IMPLICITLYCREATED = ($80000000 + (_FACDD Shl 16) + 588); + DDERR_NOTPALETTIZED = ($80000000 + (_FACDD Shl 16) + 589); + DDERR_UNSUPPORTEDMODE = ($80000000 + (_FACDD Shl 16) + 590); + DDERR_NOMIPMAPHW = ($80000000 + (_FACDD Shl 16) + 591); + DDERR_INVALIDSURFACETYPE = ($80000000 + (_FACDD Shl 16) + 592); + DDERR_NOOPTIMIZEHW = ($80000000 + (_FACDD Shl 16) + 600); + DDERR_NOTLOADED = ($80000000 + (_FACDD Shl 16) + 601); + DDERR_NOFOCUSWINDOW = ($80000000 + (_FACDD Shl 16) + 602); + DDERR_DCALREADYCREATED = ($80000000 + (_FACDD Shl 16) + 620); + DDERR_NONONLOCALVIDMEM = ($80000000 + (_FACDD Shl 16) + 630); + DDERR_CANTPAGELOCK = ($80000000 + (_FACDD Shl 16) + 640); + DDERR_CANTPAGEUNLOCK = ($80000000 + (_FACDD Shl 16) + 660); + DDERR_NOTPAGELOCKED = ($80000000 + (_FACDD Shl 16) + 680); + DDERR_MOREDATA = ($80000000 + (_FACDD Shl 16) + 690); + DDERR_EXPIRED = ($80000000 + (_FACDD Shl 16) + 691); + DDERR_VIDEONOTACTIVE = ($80000000 + (_FACDD Shl 16) + 695); + DDERR_DEVICEDOESNTOWNSURFACE = ($80000000 + (_FACDD Shl 16) + 699); + DDERR_NOTINITIALIZED = CO_E_NOTINITIALIZED; + +Type + PHWND = ^HWND; + PHDC = ^HDC; + LPLPDIRECTDRAW = ^LPDIRECTDRAW; + LPDIRECTDRAW = ^IDIRECTDRAW; + LPLPDIRECTDRAWSURFACE = ^LPDIRECTDRAWSURFACE; + LPDIRECTDRAWSURFACE = ^IDirectDrawSurface; + LPLPDIRECTDRAWCLIPPER = ^LPDIRECTDRAWCLIPPER; + LPDIRECTDRAWCLIPPER = ^IDirectDrawClipper; + LPLPDIRECTDRAWPALETTE = ^LPDIRECTDRAWPALETTE; + LPDIRECTDRAWPALETTE = ^IDirectDrawPalette; + + LPDIRECTDRAW2 = LPDIRECTDRAW; + + LPLPVOID = ^LPVOID; + LPVOID = Pointer; + LPDWORD = ^DWord; + +{ + Generic pixel format with 8-bit RGB and alpha components +} + LPDDRGBA = ^DDRGBA; + DDRGBA = Record + red, green, blue, alpha : Byte; + End; + + LPDDCOLORKEY = ^DDCOLORKEY; + DDCOLORKEY = Record + dwColorSpaceLowValue : DWord; + dwColorSpaceHighValue : DWord; + End; + LPDDBLTFX = ^DDBLTFX; + DDBLTFX = Record + dwSize : DWord; + dwDDFX : DWord; + dwROP : DWord; + dwDDROP : DWord; + dwRotationAngle : DWord; + dwZBufferOpCode : DWord; + dwZBufferLow : DWord; + dwZBufferHigh : DWord; + dwZBufferBaseDest : DWord; + dwZDestConstBitDepth : DWord; + dwZDestConst : DWord; {union w/: lpDDSZBufferDest : LPDIRECTDRAWSURFACE} + dwZSrcConstBitDepth : DWord; + dwZSrcConst : DWord; {union w/: lpDDSZBufferSrc : LPDIRECTDRAWSURFACE} + dwAlphaEdgeBlendBitDepth : DWord; + dwAlphaEdgeBlend : DWord; + dwReserved : DWord; + dwAlphaDestConstBitDepth : DWord; + dwAlphaDestConst : DWord; {union w/: lpDDSAlphaDest : LPDIRECTDRAWSURFACE} + dwAlphaSrcConstBitDepth : DWord; + dwAlphaSrcConst : DWord; {union w/: lpDDSAlphaSrc : LPDIRECTDRAWSURFACE} + dwFillColor : DWord; + {union w/: dwFillDepth : DWord} + {union w/: lpDDSPattern : LPDIRECTDRAWSURFACE} + ddckDestColorKey : DDCOLORKEY; + ddckSrcColorKey : DDCOLORKEY; + End; + LPDDPIXELFORMAT = ^DDPIXELFORMAT; + DDPIXELFORMAT = Record + dwSize : DWord; + dwFlags : DWord; + dwFourCC : DWord; + dwRGBBitCount : DWord; + { union w/: + dwYUVBitCount : DWord; + dwZBufferBitDepth : DWord; + dwAlphaBitDepth : DWord; + } + dwRBitMask : DWord; + { union w/: dwYBitMask : DWord;} + dwGBitMask : DWord; + { union w/: dwUBitMask : DWord;} + dwBBitMask : DWord; + { union w/: dwVBitMask : DWord;} + dwRGBAlphaBitMask : DWord; + { union w/: dwYUVAlphaBitMask : DWord;} + End; + LPDDSCAPS = ^DDSCAPS; + DDSCAPS = Record + dwCaps : DWord; + End; + LPDDOSCAPS = ^DDOSCAPS; + DDOSCAPS = Record + dwCaps : DWord; + End; + +{ This structure is used internally by DirectDraw.} + LPDDSCAPSEX = ^DDSCAPSEX; + DDSCAPSEX = Record + dwCaps2 : DWord; + dwCaps3 : DWord; + dwCaps4 : DWord; + End; + + LPDDSCAPS2 = ^DDSCAPS2; + DDSCAPS2 = Record + dwCaps : DWord; + dwCaps2 : DWord; + dwCaps3 : DWord; + dwCaps4 : DWord; + End; + +{This structure is the DDCAPS structure as it was in version 2 and 3 of Direct X. + It is present for back compatability.} + DDCAPS_DX3 = Record +{dwSize dd ? ; size of the DDDRIVERCAPS structure + dwCaps dd ? ; driver specific capabilities + dwCaps2 dd ? ; more driver specific capabilites + dwCKeyCaps dd ? ; color key capabilities of the surface + dwFXCaps dd ? ; driver specific stretching and effects capabilites + dwFXAlphaCaps dd ? ; alpha driver specific capabilities + dwPalCaps dd ? ; palette capabilities + dwSVCaps dd ? ; stereo vision capabilities + dwAlphaBltConstBitDepths dd ? ; DDBD_2,4,8 + dwAlphaBltPixelBitDepths dd ? ; DDBD_1,2,4,8 + dwAlphaBltSurfaceBitDepths dd ? ; DDBD_1,2,4,8 + dwAlphaOverlayConstBitDepths dd ? ; DDBD_2,4,8 + dwAlphaOverlayPixelBitDepths dd ? ; DDBD_1,2,4,8 + dwAlphaOverlaySurfaceBitDepths dd ? ; DDBD_1,2,4,8 + dwZBufferBitDepths dd ? ; DDBD_8,16,24,32 + dwVidMemTotal dd ? ; total amount of video memory + dwVidMemFree dd ? ; amount of free video memory + dwMaxVisibleOverlays dd ? ; maximum number of visible overlays + dwCurrVisibleOverlays dd ? ; current number of visible overlays + dwNumFourCCCodes dd ? ; number of four cc codes + dwAlignBoundarySrc dd ? ; source rectangle alignment + dwAlignSizeSrc dd ? ; source rectangle byte size + dwAlignBoundaryDest dd ? ; dest rectangle alignment + dwAlignSizeDest dd ? ; dest rectangle byte size + dwAlignStrideAlign dd ? ; stride alignment + dwRops dd DD_ROP_SPACE dup (?) ; ROPS supported + ddsCaps DDSCAPS ? ; DDSCAPS structure has all the general capabilities + dwMinOverlayStretch dd ? ; minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwMaxOverlayStretch dd ? ; maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwMinLiveVideoStretch dd ? ; minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwMaxLiveVideoStretch dd ? ; maximum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwMinHwCodecStretch dd ? ; minimum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwMaxHwCodecStretch dd ? ; maximum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 + dwReserved1 dd ? ; reserved + dwReserved2 dd ? ; reserved + dwReserved3 dd ? ; reserved + dwSVBCaps dd ? ; driver specific capabilities for System->Vmem blts + dwSVBCKeyCaps dd ? ; driver color key capabilities for System->Vmem blts + dwSVBFXCaps dd ? ; driver FX capabilities for System->Vmem blts + dwSVBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->Vmem blts + dwVSBCaps dd ? ; driver specific capabilities for Vmem->System blts + dwVSBCKeyCaps dd ? ; driver color key capabilities for Vmem->System blts + dwVSBFXCaps dd ? ; driver FX capabilities for Vmem->System blts + dwVSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for Vmem->System blts + dwSSBCaps dd ? ; driver specific capabilities for System->System blts + dwSSBCKeyCaps dd ? ; driver color key capabilities for System->System blts + dwSSBFXCaps dd ? ; driver FX capabilities for System->System blts + dwSSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->System blts + dwReserved4 dd ? ; reserved + dwReserved5 dd ? ; reserved + dwReserved6 dd ? ; reserved} + End; + +{This structure is the DDCAPS structure as it was in version 5 of Direct X. + It is present for back compatability.} + DDCAPS_DX5 = Record +{dwSize dd ? ; size of the DDDRIVERCAPS structure ; 4 + dwCaps dd ? ; driver specific capabilities ; 8 + dwCaps2 dd ? ; more driver specific capabilites ; c + dwCKeyCaps dd ? ; color key capabilities of the surface ; 10 + dwFXCaps dd ? ; driver specific stretching and effects capabilites ; 14 + dwFXAlphaCaps dd ? ; alpha driver specific capabilities ; 18 + dwPalCaps dd ? ; palette capabilities ; 1c + dwSVCaps dd ? ; stereo vision capabilities ; 20 + dwAlphaBltConstBitDepths dd ? ; DDBD_2,4,8 ; 24 + dwAlphaBltPixelBitDepths dd ? ; DDBD_1,2,4,8 ; 28 + dwAlphaBltSurfaceBitDepths dd ? ; DDBD_1,2,4,8 ; 2c + dwAlphaOverlayConstBitDepths dd ? ; DDBD_2,4,8 ; 30 + dwAlphaOverlayPixelBitDepths dd ? ; DDBD_1,2,4,8 ; 34 + dwAlphaOverlaySurfaceBitDepths dd ? ; DDBD_1,2,4,8 ; 38 + dwZBufferBitDepths dd ? ; DDBD_8,16,24,32 ; 3c + dwVidMemTotal dd ? ; total amount of video memory ; 40 + dwVidMemFree dd ? ; amount of free video memory ; 44 + dwMaxVisibleOverlays dd ? ; maximum number of visible overlays ; 48 + dwCurrVisibleOverlays dd ? ; current number of visible overlays ; 4c + dwNumFourCCCodes dd ? ; number of four cc codes ; 50 + dwAlignBoundarySrc dd ? ; source rectangle alignment ; 54 + dwAlignSizeSrc dd ? ; source rectangle byte size ; 58 + dwAlignBoundaryDest dd ? ; dest rectangle alignment ; 5c + dwAlignSizeDest dd ? ; dest rectangle byte size ; 60 + dwAlignStrideAlign dd ? ; stride alignment ; 64 + dwRops dd DD_ROP_SPACE dup (?) ; ROPS supported ; 84 + ddsCaps DDSCAPS ? ; DDSCAPS structure has all the general capabilities ; 88 + dwMinOverlayStretch dd ? ; minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 8c + dwMaxOverlayStretch dd ? ; maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 90 + dwMinLiveVideoStretch dd ? ; minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 94 + dwMaxLiveVideoStretch dd ? ; maximum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 98 + dwMinHwCodecStretch dd ? ; minimum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 9c + dwMaxHwCodecStretch dd ? ; maximum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; a0 + dwReserved1 dd ? ; reserved ; a4 + dwReserved2 dd ? ; reserved ; a8 + dwReserved3 dd ? ; reserved ; ac + dwSVBCaps dd ? ; driver specific capabilities for System->Vmem blts ; b0 + dwSVBCKeyCaps dd ? ; driver color key capabilities for System->Vmem blts ; b4 + dwSVBFXCaps dd ? ; driver FX capabilities for System->Vmem blts ; b8 + dwSVBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->Vmem blts ; d8 + dwVSBCaps dd ? ; driver specific capabilities for Vmem->System blts ; dc + dwVSBCKeyCaps dd ? ; driver color key capabilities for Vmem->System blts ; e0 + dwVSBFXCaps dd ? ; driver FX capabilities for Vmem->System blts ; e4 + dwVSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for Vmem->System blts ;104 + dwSSBCaps dd ? ; driver specific capabilities for System->System blts ;108 + dwSSBCKeyCaps dd ? ; driver color key capabilities for System->System blts ;10c + dwSSBFXCaps dd ? ; driver FX capabilities for System->System blts ;110 + dwSSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->System blts ; Members added for DX5: ;130 + dwMaxVideoPorts dd ? ; maximum number of usable video ports ;134 + dwCurrVideoPorts dd ? ; current number of video ports used ;138 + dwSVBCaps2 dd ? ; more driver specific capabilities for System->Vmem blts ;13c + dwNLVBCaps dd ? ; driver specific capabilities for non-local->local vidmem blts ;140 + dwNLVBCaps2 dd ? ; more driver specific capabilities non-local->local vidmem blts ;144 + dwNLVBCKeyCaps dd ? ; driver color key capabilities for non-local->local vidmem blts ;148 + dwNLVBFXCaps dd ? ; driver FX capabilities for non-local->local blts ;14c + dwNLVBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for non-local->local blts} + End; + + DDCAPS_DX6 = Record +{dwSize dd ? ; size of the DDDRIVERCAPS structure ; 4 + dwCaps dd ? ; driver specific capabilities ; 8 + dwCaps2 dd ? ; more driver specific capabilites ; c + dwCKeyCaps dd ? ; color key capabilities of the surface ; 10 + dwFXCaps dd ? ; driver specific stretching and effects capabilites ; 14 + dwFXAlphaCaps dd ? ; alpha caps ; 18 + dwPalCaps dd ? ; palette capabilities ; 1c + dwSVCaps dd ? ; stereo vision capabilities ; 20 + dwAlphaBltConstBitDepths dd ? ; DDBD_2,4,8 ; 24 + dwAlphaBltPixelBitDepths dd ? ; DDBD_1,2,4,8 ; 28 + dwAlphaBltSurfaceBitDepths dd ? ; DDBD_1,2,4,8 ; 2c + dwAlphaOverlayConstBitDepths dd ? ; DDBD_2,4,8 ; 30 + dwAlphaOverlayPixelBitDepths dd ? ; DDBD_1,2,4,8 ; 34 + dwAlphaOverlaySurfaceBitDepths dd ? ; DDBD_1,2,4,8 ; 38 + dwZBufferBitDepths dd ? ; DDBD_8,16,24,32 ; 3c + dwVidMemTotal dd ? ; total amount of video memory ; 40 + dwVidMemFree dd ? ; amount of free video memory ; 44 + dwMaxVisibleOverlays dd ? ; maximum number of visible overlays ; 48 + dwCurrVisibleOverlays dd ? ; current number of visible overlays ; 4c + dwNumFourCCCodes dd ? ; number of four cc codes ; 50 + dwAlignBoundarySrc dd ? ; source rectangle alignment ; 54 + dwAlignSizeSrc dd ? ; source rectangle byte size ; 58 + dwAlignBoundaryDest dd ? ; dest rectangle alignment ; 5c + dwAlignSizeDest dd ? ; dest rectangle byte size ; 60 + dwAlignStrideAlign dd ? ; stride alignment ; 64 + dwRops dd DD_ROP_SPACE dup (?) ; ROPS supported ; 84 + ddsOldCaps DDSCAPS ? ; Was DDSCAPS ddsCaps. ddsCaps is of type DDSCAPS2 for DX6 ; 88 + dwMinOverlayStretch dd ? ; minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 8c + dwMaxOverlayStretch dd ? ; maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 90 + dwMinLiveVideoStretch dd ? ; minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 94 + dwMaxLiveVideoStretch dd ? ; maximum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 98 + dwMinHwCodecStretch dd ? ; minimum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; 9c + dwMaxHwCodecStretch dd ? ; maximum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3 ; a0 + dwReserved1 dd ? ; reserved ; a4 + dwReserved2 dd ? ; reserved ; a8 + dwReserved3 dd ? ; reserved ; ac + dwSVBCaps dd ? ; driver specific capabilities for System->Vmem blts ; b0 + dwSVBCKeyCaps dd ? ; driver color key capabilities for System->Vmem blts ; b4 + dwSVBFXCaps dd ? ; driver FX capabilities for System->Vmem blts ; b8 + dwSVBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->Vmem blts ; d8 + dwVSBCaps dd ? ; driver specific capabilities for Vmem->System blts ; dc + dwVSBCKeyCaps dd ? ; driver color key capabilities for Vmem->System blts ; e0 + dwVSBFXCaps dd ? ; driver FX capabilities for Vmem->System blts ; e4 + dwVSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for Vmem->System blts ;104 + dwSSBCaps dd ? ; driver specific capabilities for System->System blts ;108 + dwSSBCKeyCaps dd ? ; driver color key capabilities for System->System blts ;10c + dwSSBFXCaps dd ? ; driver FX capabilities for System->System blts ;110 + dwSSBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for System->System blts ;130 + dwMaxVideoPorts dd ? ; maximum number of usable video ports ;134 + dwCurrVideoPorts dd ? ; current number of video ports used ;138 + dwSVBCaps2 dd ? ; more driver specific capabilities for System->Vmem blts ;13c + dwNLVBCaps dd ? ; driver specific capabilities for non-local->local vidmem blts ;140 + dwNLVBCaps2 dd ? ; more driver specific capabilities non-local->local vidmem blts ;144 + dwNLVBCKeyCaps dd ? ; driver color key capabilities for non-local->local vidmem blts ;148 + dwNLVBFXCaps dd ? ; driver FX capabilities for non-local->local blts ;14c + dwNLVBRops dd DD_ROP_SPACE dup (?) ; ROPS supported for non-local->local blts ; Members added for DX6 release ;16c + ddsCaps DDSCAPS2 ? ; Surface Caps} + End; + LPDDCAPS = ^DDCAPS; + DDCAPS = DDCAPS_DX6; + {DDCAPS = DDCAPS_DX5;} + {DDCAPS = DDCAPS_DX3;} + + LPDDSURFACEDESC = ^DDSURFACEDESC; + DDSURFACEDESC = Record + dwSize : DWord; + dwFlags : DWord; + dwHeight : DWord; + dwWidth : DWord; + lPitch : LongInt; + dwBackBufferCount : DWord; + dwMipMapCount : DWord; + { union w/: + dwZBufferBitDepth : DWord; + dwRefreshRate : DWord; + } + dwAlphaBitDepth : DWord; + dwReserved : DWord; + lpSurface : LPVOID; + ddckCKDestOverlay : DDCOLORKEY; + ddckCKDestBlt : DDCOLORKEY; + + ddckCKSrcOverlay : DDCOLORKEY; + ddckCKSrcBlt : DDCOLORKEY; + ddpfPixelFormat : DDPIXELFORMAT; + ddsCaps : DDSCAPS; + End; + LPDDOVERLAYFX = ^DDOVERLAYFX; + DDOVERLAYFX = Record + dwSize : DWord; + dwAlphaEdgeBlendBitDepth : DWord; + dwAlphaEdgeBlend : DWord; + dwReserved : DWord; + dwAlphaDestConstBitDepth : DWord; + dwAlphaDestConst : DWord; + {union w/: lpDDSAlphaDest : LPDIRECTDRAWSURFACE;} + dwAlphaSrcConstBitDepth : DWord; + dwAlphaSrcConst : DWord; + {union w/: lpDDSAlphaSrc : LPDIRECTDRAWSURFACE;} + dckDestColorkey : DDCOLORKEY; + dckSrcColorkey : DDCOLORKEY; + + dwDDFX : DWord; + dwFlags : DWord; + End; + LPDDBLTBATCH = ^DDBLTBATCH; + DDBLTBATCH = Record + lprDest : LPRECT; + lpDDSSrc : LPDIRECTDRAWSURFACE; + lprSrc : LPRECT; + dwFlags : DWord; + lpDDBltFx : LPDDBLTFX; + End; + LPDDGAMMARAMP = ^DDGAMMARAMP; + DDGAMMARAMP = Record + red : Array[0..255] Of Word; + green : Array[0..255] Of Word; + blue : Array[0..255] Of Word; + End; +{; +; This is the structure within which DirectDraw returns data about the current graphics driver and chipset +; + +MAX_DDDEVICEID_STRING = 512 + + +struc DDDEVICEIDENTIFIER + szDriver db MAX_DDDEVICEID_STRING dup (?) + szDescription db MAX_DDDEVICEID_STRING dup (?) +label liDriverVersion qword + dwDriverVersionLowPart dd ? + dwDriverVersionHighPart dd ? + dwVendorId dd ? + dwDeviceId dd ? + dwSubSysId dd ? + dwRevision dd ? + guidDeviceIdentifier GUID ? +ends} +{; +; Flags for the IDirectDraw4::GetDeviceIdentifier method +; + +DDGDI_GETHOSTIDENTIFIER = 000000001h + +proctype CLIPPERCALLBACK :dword, :dword, :dword, :dword +proctype SURFACESTREAMINGCALLBACK :dword} +(* LPDDCAPS = ^DDCAPS; + DDCAPS = Record + dwSize : DWord; + {todo...} + End;*) + + LPDDCOLORCONTROL = ^DDCOLORCONTROL; + DDCOLORCONTROL = Record + dwSize : DWord; + dwFlags : DWord; + lBrightness : LongInt; + lContrast : LongInt; + lHue : LongInt; + lSaturation : LongInt; + lSharpness : LongInt; + lGamma : LongInt; + lColorEnable : LongInt; + dwReserved1 : DWord; + End; + + LPDDENUMCALLBACK = Pointer; {CDecl; (maybe) NO CDECL! STDCALL!} + LPDDENUMMODESCALLBACK = Pointer; {CDecl; !!! NO CDECL! STDCALL! todo:check DX SDK} + LPDDENUMSURFACESCALLBACK = Pointer; {CDecl; (maybe) NO CDECL! STDCALL!} + { + BOOL WINAPI lpCallback(GUID FAR * lpGUID, LPSTR lpDriverDescription, LPSTR lpDriverName, LPVOID lpContext); + HRESULT WINAPI lpEnumModesCallback(LPDDSURFACEDESC lpDDSurfaceDesc, LPVOID lpContext); + HRESULT WINAPI lpEnumSurfacesCallback(LPDIRECTDRAWSURFACE2 lpDDSurface, LPDDSURFACEDESC lpDDSurfaceDesc, LPVOID lpContext); + HRESULT WINAPI lpfnCallback(LPDIRECTDRAWSURFACE lpDDSurface, LPVOID lpContext); + } + + +{ +; INTERFACES FOLLOW: +; IDirectDraw +; IDirectDrawClipper +; IDirectDrawPalette +; IDirectDrawSurface +; + +; +; IDirectDraw +; + +struc IDirectDraw +;** IUnknown methods ** + QueryInterface dd ? 0 + AddRef dd ? 1 + Release dd ? 2 +;** IDirectDraw methods ** + Compact dd ? 3 + CreateClipper dd ? 4 + CreatePalette dd ? 5 + CreateSurface dd ? 6 + DuplicateSurface dd ? 7 + EnumDisplayModes dd ? 8 + EnumSurfaces dd ? 9 + FlipToGDISurface dd ? 10 + GetCaps dd ? 11 + GetDisplayMode dd ? 12 + GetFourCCCodes dd ? 13 + GetGDISurface dd ? 14 + GetMonitorFrequency dd ? 15 + GetScanLine dd ? 16 + GetVerticalBlankStatus dd ? 17 + Initialize dd ? 18 + RestoreDisplayMode dd ? 19 + SetCooperativeLevel dd ? 20 + SetDisplayMode dd ? 21 + WaitForVerticalBlank dd ? 22 +;** IDirectDraw2 methods ** + GetAvailableVidMem dd ? 23 +;** IDirectDraw4 methods ** + GetSurfaceFromDC dd ? 24 + RestoreAllSurfaces dd ? 25 + TestCooperativeLevel dd ? 26 + GetDeviceIdentifier dd ? 27 +ends + +typedef IDirectDraw2 IDirectDraw +typedef IDirectDraw4 IDirectDraw} + IDirectDraw = Record + lpVtbl : ^IDirectDrawVtbl; + End; + IDirectDraw2 = IDirectDraw; + IDirectDraw4 = IDirectDraw; + IDirectDrawVtbl = Record + QueryInterface : Function(obj : LPDIRECTDRAW; sht : LPGUID; lplpGUZ : LPLPVOID) : DWord; DXCall; + AddRef : Function(obj : LPDIRECTDRAW) : DWord; DXCall; + Release : Function(obj : LPDIRECTDRAW) : DWord; DXCall; + Compact : Function(obj : LPDIRECTDRAW) : HResult; DXCall; + CreateClipper : Function(obj : LPDIRECTDRAW; + dwFlags : DWord; lplpDDClipper : LPLPDIRECTDRAWCLIPPER; + pUnkOther : Pointer) : HResult; DXCall; + CreatePalette : Function(obj : LPDIRECTDRAW; + dwFlags : DWord; lpColorTable : LPPALETTEENTRY; + lplpDDPalette : LPLPDIRECTDRAWPALETTE; + pUnkOther : Pointer) : HResult; DXCall; + CreateSurface : Function(obj : LPDIRECTDRAW; + lpDDSurfaceDesc : LPDDSURFACEDESC; + lplpDDSurface : LPLPDIRECTDRAWSURFACE; + pUnkOther : Pointer) : HResult; DXCall; + DuplicateSurface : Function(obj : LPDIRECTDRAW; + lpDDSurface : LPDIRECTDRAWSURFACE; + lplpDupDDSurface : LPLPDIRECTDRAWSURFACE) : HResult; DXCall; + EnumDisplayModes : Function(obj : LPDIRECTDRAW; + dwFlags : DWord; lpDDSurfaceDesc : LPDDSURFACEDESC; + lpContext : LPVOID; + lpEnumModesCallback : LPDDENUMMODESCALLBACK) : HResult; DXCall; + EnumSurfaces : Function(obj : LPDIRECTDRAW; + dwFlags : DWord; lpDDSD : LPDDSURFACEDESC; + lpContext : LPVOID; + lpEnumSurfacesCallback : LPDDENUMSURFACESCALLBACK) : HResult; DXCall; +{ dummy1, dummy2 : DWord;} + FlipToGDISurface : Function(obj : LPDIRECTDRAW) : HResult; DXCall; + GetCaps : Function(obj : LPDIRECTDRAW; lpDDDriverCaps : LPDDCAPS; + lpDDHELCaps : LPDDCAPS) : HResult; DXCall; + GetDisplayMode : Function(obj : LPDIRECTDRAW; + lpDDSurfaceDesc : LPDDSURFACEDESC) : HResult; DXCall; + GetFourCCCodes : Function(obj : LPDIRECTDRAW; + lpNumCodes : LPDWORD; lpCodes : LPDWORD) : HResult; DXCall; + GetGDISurface : Function(obj : LPDIRECTDRAW; + lplpGDIDDSSurface : LPLPDIRECTDRAWSURFACE) : HResult; DXCall; + GetMonitorFrequency : Function(obj : LPDIRECTDRAW; + lpdwFrequency : LPDWORD) : HResult; DXCall; + GetScanLine : Function(obj : LPDIRECTDRAW; + lpdwScanLine : LPDWORD) : HResult; DXCall; + GetVerticalBlankStatus : Function(obj : LPDIRECTDRAW; + lpbIsInVB : LPBOOL) : HResult; DXCall; + {Function DirectDraw_Initialize(obj : LPDIRECTDRAW) : HResult; DXCall;} + Initialize : DWord; + RestoreDisplayMode : Function(obj : LPDIRECTDRAW) : HResult; DXCall; + SetCooperativeLevel : Function(obj : LPDIRECTDRAW; + hWnd : HWND; dwFlags : DWord) : HResult; DXCall; + SetDisplayMode : Function(obj : LPDIRECTDRAW; + dwWidth, dwHeight, dwBPP, dwRefreshRate, dwFlags : DWord) : HResult; DXCall; + WaitForVerticalBlank : Function(obj : LPDIRECTDRAW; + dwFlags : DWord; hEvent : HANDLE) : HResult; DXCall; + GetAvailableVidMem : Function(obj : LPDIRECTDRAW; + lpDDSCaps : LPDDSCAPS; lpdwTotal : LPDWORD; lpdwFree : LPDWORD) : HResult; DXCall; + End; + +(*Function DirectDraw_AddRef(obj : LPDIRECTDRAW) : DWord; +Function DirectDraw_Release(obj : LPDIRECTDRAW) : DWord; +Function DirectDraw_Compact(obj : LPDIRECTDRAW) : HResult; +Function DirectDraw_CreateClipper(obj : LPDIRECTDRAW; + dwFlags : DWord; lplpDDClipper : LPLPDIRECTDRAWCLIPPER; + pUnkOther : Pointer) : HResult; +Function DirectDraw_CreatePalette(obj : LPDIRECTDRAW; + dwFlags : DWord; lpColorTable : LPPALETTEENTRY; + lplpDDPalette : LPLPDIRECTDRAWPALETTE; + pUnkOther : Pointer) : HResult; +Function DirectDraw_CreateSurface(obj : LPDIRECTDRAW; + lpDDSurfaceDesc : LPDDSURFACEDESC; + lplpDDSurface : LPLPDIRECTDRAWSURFACE; + pUnkOther : Pointer) : HResult; +Function DirectDraw_DuplicateSurface(obj : LPDIRECTDRAW; + lpDDSurface : LPDIRECTDRAWSURFACE; + lplpDupDDSurface : LPLPDIRECTDRAWSURFACE) : HResult; +Function DirectDraw_EnumDisplayModes(obj : LPDIRECTDRAW; + dwFlags : DWord; lpDDSurfaceDesc : LPDDSURFACEDESC; + lpContext : LPVOID; + lpEnumModesCallback : LPDDENUMMODESCALLBACK) : HResult; +Function DirectDraw_EnumSurfaces(obj : LPDIRECTDRAW; + dwFlags : DWord; lpDDSD : LPDDSURFACEDESC; + lpContext : LPVOID; + lpEnumSurfacesCallback : LPDDENUMSURFACESCALLBACK) : HResult; +Function DirectDraw_FlipToGDISurface(obj : LPDIRECTDRAW) : HResult; +Function DirectDraw_GetCaps(obj : LPDIRECTDRAW; lpDDDriverCaps : LPDDCAPS; + lpDDHELCaps : LPDDCAPS) : HResult; +Function DirectDraw_GetDisplayMode(obj : LPDIRECTDRAW; + lpDDSurfaceDesc : LPDDSURFACEDESC) : HResult; +Function DirectDraw_GetFourCCCodes(obj : LPDIRECTDRAW; + lpNumCodes : LPDWORD; lpCodes : LPDWORD) : HResult; +Function DirectDraw_GetGDISurface(obj : LPDIRECTDRAW; + lplpGDIDDSSurface : LPLPDIRECTDRAWSURFACE) : HResult; +Function DirectDraw_GetMonitorFrequency(obj : LPDIRECTDRAW; + lpdwFrequency : LPDWORD) : HResult; +Function DirectDraw_GetScanLine(obj : LPDIRECTDRAW; + lpdwScanLine : LPDWORD) : HResult; +Function DirectDraw_GetVerticalBlankStatus(obj : LPDIRECTDRAW; + lpbIsInVB : LPBOOL) : HResult; +{Function DirectDraw_Initialize(obj : LPDIRECTDRAW) : HResult;} +Function DirectDraw_RestoreDisplayMode(obj : LPDIRECTDRAW) : HResult; +Function DirectDraw_SetCooperativeLevel(obj : LPDIRECTDRAW; + hWnd : HWND; dwFlags : DWord) : HResult; +Function DirectDraw_SetDisplayMode(obj : LPDIRECTDRAW; + dwWidth, dwHeight, dwBPP, dwRefreshRate, dwFlags : DWord) : HResult; +Function DirectDraw_WaitForVerticalBlank(obj : LPDIRECTDRAW; + dwFlags : DWord; hEvent : HANDLE) : HResult; +Function DirectDraw_GetAvailableVidMem(obj : LPDIRECTDRAW; + lpDDSCaps : LPDDSCAPS; lpdwTotal : LPDWORD; lpdwFree : LPDWORD) : HResult;*) + + + IDirectDrawPalette = Record + lpVtbl : ^IDirectDrawPaletteVtbl; + End; + IDirectDrawPaletteVtbl = Record + q : Pointer; + AddRef : Function(obj : LPDIRECTDRAWPALETTE) : DWord; DXCall; + Release : Function(obj : LPDIRECTDRAWPALETTE) : DWord; DXCall; + GetCaps : Function(obj : LPDIRECTDRAWPALETTE; + lpdwCaps : LPDWORD) : HRESULT; DXCall; + GetEntries : Function(obj : LPDIRECTDRAWPALETTE; + dwFlags, dwBase, dwNumEntries : DWord; + lpEntries : LPPALETTEENTRY) : HRESULT; DXCall; + Initialize : Function(obj : LPDIRECTDRAWPALETTE; + lpDD : LPDIRECTDRAW; dwFlags : DWord; + lpDDColorTable : LPPALETTEENTRY) : HRESULT; DXCall; + SetEntries : Function(obj : LPDIRECTDRAWPALETTE; + dwFlags, dwStartingEntry, dwCount : DWord; + lpEntries : LPPALETTEENTRY) : HRESULT; DXCall; + End; + +{ +; +; IDirectDrawPalette +; + +struc IDirectDrawPalette +;** IUnknown methods ** + QueryInterface dd ? + AddRef dd ? + Release dd ? +;** IDirectDrawPalette methods ** + GetCaps dd ? + GetEntries dd ? + Initialize dd ? + SetEntries dd ? +ends} + + IDirectDrawClipper = Record + lpVtbl : ^IDirectDrawClipperVtbl; + End; + IDirectDrawClipperVtbl = Record + q : Pointer; + AddRef : Function(obj : LPDIRECTDRAWCLIPPER) : DWord; DXCall; + Release : Function(obj : LPDIRECTDRAWCLIPPER) : DWord; DXCall; + GetClipList : Function(obj : LPDIRECTDRAWCLIPPER; + lpRect : LPRECT; lpClipList : LPRGNDATA; + lpdwSize : LPDWORD) : HRESULT; DXCall; + GetHWnd : Function(obj : LPDIRECTDRAWCLIPPER; + lphWnd : PHWND) : HRESULT; DXCall; + Initialize : Function(obj : LPDIRECTDRAWCLIPPER; + lpDD : LPDIRECTDRAW; dwFlags : DWord) : HRESULT; DXCall; + IsClipListChanged : Function(obj : LPDIRECTDRAWCLIPPER; + lpbChanged : PBoolean) : HRESULT; DXCall; + SetClipList : Function(obj : LPDIRECTDRAWCLIPPER; + lpClipList : LPRGNDATA; + dwFlags : DWord) : HRESULT; DXCall; + SetHWnd : Function(obj : LPDIRECTDRAWCLIPPER; + dwFlags : DWord; hWnd : HWND) : HRESULT; DXCall; + End; + +{; +; IDirectDrawClipper +; + +struc IDirectDrawClipper +;** IUnknown methods ** + QueryInterface dd ? + AddRef dd ? + Release dd ? +;** IDirectDrawClipper methods ** + GetClipList dd ? + GetHWnd dd ? + Initialize dd ? + IsClipListChanged dd ? + SetClipList dd ? + SetHWnd dd ? +ends} + + IDirectDrawSurface = Record + lpVtbl : ^IDirectDrawSurfaceVtbl; + End; + IDirectDrawSurface2 = IDirectDrawSurface; + IDirectDrawSurface3 = IDirectDrawSurface; + IDirectDrawSurface4 = IDirectDrawSurface; + IDirectDrawSurfaceVtbl = Record + q : Pointer; + AddRef : Function(obj : LPDIRECTDRAWSURFACE) : DWord; DXCall; + Release : Function(obj : LPDIRECTDRAWSURFACE) : DWord; DXCall; + AddAttachedSurface : Function(obj : LPDIRECTDRAWSURFACE; + lpDDSAttachedSurface : LPDIRECTDRAWSURFACE{2}) : HRESULT; DXCall; + AddOverlayDirtyRect : Function(obj : LPDIRECTDRAWSURFACE; + lpRect : LPRECT) : HRESULT; DXCall; + Blt : Function(obj : LPDIRECTDRAWSURFACE; lpDestRect : LPRECT; + lpDDSrcSurface : LPDIRECTDRAWSURFACE{2}; lpSrcRect : LPRECT; + dwFlags : DWord; lpDDBltFx : LPDDBLTFX) : HRESULT; DXCall; + BltBatch : Function(obj : LPDIRECTDRAWSURFACE; + lpDDBltBatch : LPDDBLTBATCH; dwCount, dwFlags : DWord) : HRESULT; DXCall; + BltFast : Function(obj : LPDIRECTDRAWSURFACE; dwX, dwY : DWord; + lpDDSrcSurface : LPDIRECTDRAWSURFACE{2}; lpSrcRect : LPRECT; + dwTrans : DWord) : HRESULT; DXCall; + DeleteAttachedSurface : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord; + lpDDSAttachedSurface : LPDIRECTDRAWSURFACE{2}) : HRESULT; DXCall; + EnumAttachedSurfaces : Function(obj : LPDIRECTDRAWSURFACE; + lpContext : LPVOID; + lpEnumSurfacesCallback : LPDDENUMSURFACESCALLBACK) : HRESULT; DXCall; + EnumOverlayZOrders : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord; lpContext : LPVOID; + lpfnCallback : LPDDENUMSURFACESCALLBACK) : HRESULT; DXCall; + Flip : Function(obj : LPDIRECTDRAWSURFACE; + lpDDSurfaceTargetOverride : LPDIRECTDRAWSURFACE{2}; + dwFlags : DWord) : HRESULT; DXCall; + GetAttachedSurface : Function(obj : LPDIRECTDRAWSURFACE; + lpDDSCaps : LPDDSCAPS; + lplpDDAttachedSurface : LPLPDIRECTDRAWSURFACE{2}) : HRESULT; DXCall; + GetBltStatus : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord) : HRESULT; DXCall; + GetCaps : Function(obj : LPDIRECTDRAWSURFACE; + lpDDSCaps : LPDDSCAPS) : HRESULT; DXCall; + GetClipper : Function(obj : LPDIRECTDRAWSURFACE; + lplpDDClipper : LPLPDIRECTDRAWCLIPPER) : HRESULT; DXCall; + GetColorKey : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord; lpDDColorKey : LPDDCOLORKEY) : HRESULT; DXCall; + GetDC : Function(obj : LPDIRECTDRAWSURFACE; + lphDC : PHDC) : HRESULT; DXCall; + GetFlipStatus : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord) : HRESULT; DXCall; + GetOverlayPosition : Function(obj : LPDIRECTDRAWSURFACE; + lplX, lplY : LPDWORD) : HRESULT; DXCall; + GetPalette : Function(obj : LPDIRECTDRAWSURFACE; + lplpDDPalette : LPLPDIRECTDRAWPALETTE) : HRESULT; DXCall; + GetPixelFormat : Function(obj : LPDIRECTDRAWSURFACE; + lpDDPixelFormat : LPDDPIXELFORMAT) : HRESULT; DXCall; + GetSurfaceDesc : Function(obj : LPDIRECTDRAWSURFACE; + lpDDSurfaceDesc : LPDDSURFACEDESC) : HRESULT; DXCall; + Initialize : Function(obj : LPDIRECTDRAWSURFACE; + lpDD : LPDIRECTDRAW; + lpDDSurfaceDesc : LPDDSURFACEDESC) : HRESULT; DXCall; + IsLost : Function(obj : LPDIRECTDRAWSURFACE) : HRESULT; DXCall; + Lock : Function(obj : LPDIRECTDRAWSURFACE; + lpDestRect : LPRECT; lpDDSurfaceDesc : LPDDSURFACEDESC; + dwFlags : DWord; hEvent : HANDLE) : HRESULT; DXCall; + ReleaseDC : Function(obj : LPDIRECTDRAWSURFACE; + hDC : HDC) : HRESULT; DXCall; + Restore : Function(obj : LPDIRECTDRAWSURFACE) : HRESULT; DXCall; + SetClipper : Function(obj : LPDIRECTDRAWSURFACE; + lpDDClipper : LPDIRECTDRAWCLIPPER) : HRESULT; DXCall; + SetColorKey : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord; lpDDColorKey : LPDDCOLORKEY) : HRESULT; DXCall; + SetOverlayPosition : Function(obj : LPDIRECTDRAWSURFACE; + lX, lY : LongInt) : HRESULT; DXCall; + SetPalette : Function(obj : LPDIRECTDRAWSURFACE; + lpDDPalette : LPDIRECTDRAWPALETTE) : HRESULT; DXCall; + Unlock : Function(obj : LPDIRECTDRAWSURFACE; + lpSurfaceData : LPVOID) : HRESULT; DXCall; + UpdateOverlay : Function(obj : LPDIRECTDRAWSURFACE; + lpSrcRect : LPRECT; lpDDDestSurface : LPDIRECTDRAWSURFACE{2}; + lpDestRect : LPRECT; dwFlags : DWord; + lpDDOverlayFx : LPDDOVERLAYFX) : HRESULT; DXCall; + UpdateOverlayDisplay : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord) : HRESULT; DXCall; + UpdateOverlayZOrder : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord; + lpDDSReference : LPDIRECTDRAWSURFACE{2}) : HRESULT; DXCall; + {v2} + GetDDInterface : Function(obj : LPDIRECTDRAWSURFACE; + lplpDD : LPLPVOID) : HRESULT; DXCall; + PageLock : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord) : HRESULT; DXCall; + PageUnlock : Function(obj : LPDIRECTDRAWSURFACE; + dwFlags : DWord) : HRESULT; DXCall; + {v3} +{ SetSurfaceDesc} + {v4} +{ SetPrivateData + GetPrivateData + FreePrivateData + GetUniquenessValue + ChangeUniquenessValue} + End; +{; +; IDirectDrawSurface and related interfaces +; + +struc IDirectDrawSurface +;** IUnknown methods ** + QueryInterface dd ? + AddRef dd ? + Release dd ? +;** IDirectDrawSurface methods ** + AddAttachedSurface dd ? + AddOverlayDirtyRect dd ? + Blt dd ? + BltBatch dd ? + BltFast dd ? + DeleteAttachedSurface dd ? + EnumAttachedSurfaces dd ? + EnumOverlayZOrders dd ? + Flip dd ? + GetAttachedSurface dd ? + GetBltStatus dd ? + GetCaps dd ? + GetClipper dd ? + GetColorKey dd ? + GetDC dd ? + GetFlipStatus dd ? + GetOverlayPosition dd ? + GetPalette dd ? + GetPixelFormat dd ? + GetSurfaceDesc dd ? + Initialize dd ? + IsLost dd ? + _Lock dd ? + ReleaseDC dd ? + Restore dd ? + SetClipper dd ? + SetColorKey dd ? + SetOverlayPosition dd ? + SetPalette dd ? + Unlock dd ? + UpdateOverlay dd ? + UpdateOverlayDisplay dd ? + UpdateOverlayZOrder dd ? +;** Added in the v2 interface ** + GetDDInterface dd ? + PageLock dd ? + PageUnlock dd ? +;** Added in the v3 interface ** + SetSurfaceDesc dd ? +;** Added in the v4 interface ** + SetPrivateData dd ? + GetPrivateData dd ? + FreePrivateData dd ? + GetUniquenessValue dd ? + ChangeUniquenessValue dd ? +ends + +typedef IDirectDrawSurface2 IDirectDrawSurface +typedef IDirectDrawSurface3 IDirectDrawSurface +typedef IDirectDrawSurface4 IDirectDrawSurface +} + +{ +; +; IDirectDrawColorControl +; + +struc IDirectDrawColorControl +;** IUnknown methods ** + QueryInterface dd ? + AddRef dd ? + Release dd ? +;** IDirectDrawColorControl methods ** + GetColorControls dd ? + SetColorControls dd ? +ends + +; +; IDirectDrawGammaControl +; + +struc IDirectDrawGammaControl +;** IUnknown methods ** + QueryInterface dd ? + AddRef dd ? + Release dd ? +;** IDirectDrawColorControl methods ** + GetGammaRamp dd ? + SetGammaRamp dd ? +ends} + + TDirectDrawCreate = Function(lpGUID : Pointer; lplpDD : LPLPDIRECTDRAW; pUnkOuter : Pointer{IUnknown FAR *}) : HRESULT; DXCall; + TDirectDrawCreateClipper = Function(dwFlags : DWord; lplpDDClipper : LPLPDIRECTDRAWCLIPPER; pUnkOuter : Pointer{IUnknown FAR *}) : HRESULT; DXCall; + TDirectDrawEnumerate = Function(lpCallback : LPDDENUMCALLBACK; lpContext : LPVOID) : HRESULT; DXCall; {DirectDrawEnumerateA} + TDirectDrawEnumerateEx = Function(A, B, C : DWord) : HRESULT; DXCall; {DirectDrawEnumerateExA} + +Var + DirectDrawCreate : TDirectDrawCreate; + DirectDrawCreateClipper : TDirectDrawCreateClipper; + DirectDrawEnumerate : TDirectDrawEnumerate; + DirectDrawEnumerateEx : TDirectDrawEnumerateEx; + +Implementation + +Begin + DirectDrawCreate := Nil; + DirectDrawCreateClipper := Nil; + DirectDrawEnumerate := Nil; + DirectDrawEnumerateEx := Nil; +End. diff --git a/packages/ptc/src/win32/directx/directxconsole.inc b/packages/ptc/src/win32/directx/directxconsole.inc new file mode 100644 index 0000000000..a775448538 --- /dev/null +++ b/packages/ptc/src/win32/directx/directxconsole.inc @@ -0,0 +1,1315 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +{$MACRO ON} + +{$DEFINE DEFAULT_WIDTH:=320} +{$DEFINE DEFAULT_HEIGHT:=200} +{$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)} +{$IFDEF DEBUG} +{$DEFINE DEFAULT_OUTPUT:=WINDOWED} +{$ELSE} +{$DEFINE DEFAULT_OUTPUT:=DEFAULT} +{$ENDIF} +{$IFNDEF DEBUG} +{$DEFINE CHECK_OPEN:=//} +{$DEFINE CHECK_LOCK:=//} +{$ENDIF} + +Const + {Output} + DEFAULT = 0; + WINDOWED = 1; + FULLSCREEN = 2; + + {Window} + RESIZABLE = 0; + FIXED = 1; + + {Primary} + DIRECT = 0; + SECONDARY = 1; + + {Nearest} + NEAREST_DEFAULT = 0; + NEAREST_CENTERING = 1; + NEAREST_STRETCHING = 2; + + {Cursor} + CURSOR_DEFAULT = 0; + CURSOR_SHOW = 1; + CURSOR_HIDE = 2; + +Function PChar2String(Q : PChar) : String; + +Var + I : Integer; + S : String; + +Begin + S := ''; + I := 0; + While Q[I] <> #0 Do + Begin + S := S + Q[I]; + Inc(I); + End; + PChar2String := S; +End; + +Constructor TDirectXConsole.Create; + +Begin + { clear objects } + m_default_format := Nil; + m_hook := Nil; + m_window := Nil; + m_keyboard := Nil; + m_copy := Nil; + m_library := Nil; + m_display := Nil; + m_primary := Nil; + m_copy := TPTCCopy.Create; + m_library := TDirectXLibrary.Create; + m_display := TDirectXDisplay.Create; + m_primary := TDirectXPrimary.Create; + + { defaults } + m_open := False; + m_locked := False; + m_cursor := True; + + { clear strings } +{ m_title[0] := #0;} + m_title := ''; + + { default option data } + m_frequency := 0; + m_default_width := DEFAULT_WIDTH; + m_default_height := DEFAULT_HEIGHT; + m_default_format := DEFAULT_FORMAT; + m_center_window := False; + m_synchronized_update := True; + m_output_mode := DEFAULT_OUTPUT; + m_window_mode := RESIZABLE; + m_primary_mode_windowed := SECONDARY; + m_primary_mode_fullscreen := DIRECT; + m_nearest_mode := NEAREST_DEFAULT; + m_cursor_mode := CURSOR_DEFAULT; + + { configure console } + configure('ptc.cfg'); + + { setup display object } + m_display.setup(m_library.lpDD2); +End; + +Destructor TDirectXConsole.Destroy; + +Begin + { close } + close; + + m_hook.Free; + m_keyboard.Free; + m_window.Free; + + m_primary.Free; + m_display.Free; + m_library.Free; + m_copy.Free; + m_default_format.Free; + Inherited Destroy; +End; + +Procedure TDirectXConsole.configure(Const _file : String); + +Var + F : Text; + S : String; + +Begin + ASSignFile(F, _file); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + option(S); + End; + CloseFile(F); +End; + +Function TDirectXConsole.option(Const _option : String) : Boolean; + +Var + tmp, tmp2 : Integer; + tmpformat : TPTCFormat; + +Begin + LOG('console option', _option); + option := True; + If _option = 'default output' Then + Begin + m_output_mode := DEFAULT; + Exit; + End; + If _option = 'windowed output' Then + Begin + m_output_mode := WINDOWED; + Exit; + End; + If _option = 'fullscreen output' Then + Begin + m_output_mode := FULLSCREEN; + Exit; + End; + If System.Copy(_option, 1, 13) = 'default width' Then + Begin + If Length(_option) > 13 Then + Begin + Val(System.Copy(_option, 14, Length(_option)-13), m_default_width, tmp); + If m_default_width = 0 Then + m_default_width := DEFAULT_WIDTH; + End + Else + Begin + m_default_width := DEFAULT_WIDTH; + End; + End; + If System.Copy(_option, 1, 14) = 'default height' Then + Begin + If Length(_option) > 14 Then + Begin + Val(System.Copy(_option, 15, Length(_option)-14), m_default_height, tmp); + If m_default_height = 0 Then + m_default_height := DEFAULT_HEIGHT; + End + Else + Begin + m_default_height := DEFAULT_HEIGHT; + End; + End; + If System.Copy(_option, 1, 12) = 'default bits' Then + Begin + If Length(_option) > 12 Then + Begin + Val(System.Copy(_option, 13, Length(_option)-12), tmp, tmp2); + Case tmp Of + 8 : tmpformat := TPTCFormat.Create(8); + 16 : tmpformat := TPTCFormat.Create(16, $F800, $07E0, $001F); + 24 : tmpformat := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + 32 : tmpformat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + Else + Exit(False); + End; + Try + m_default_format.ASSign(tmpformat); + Finally + tmpformat.Free; + End; + End + Else + Begin + tmpformat := DEFAULT_FORMAT; + Try + m_default_format.ASSign(tmpformat); + Finally + tmpformat.Free; + End; + End; + End; + If _option = 'resizable window' Then + Begin + m_window_mode := RESIZABLE; + Exit; + End; + If _option = 'fixed window' Then + Begin + m_window_mode := FIXED; + Exit; + End; + If _option = 'windowed primary direct' Then + Begin + m_primary_mode_windowed := DIRECT; + Exit; + End; + If _option = 'windowed primary secondary' Then + Begin + m_primary_mode_windowed := SECONDARY; + Exit; + End; + If _option = 'fullscreen primary direct' Then + Begin + m_primary_mode_fullscreen := DIRECT; + Exit; + End; + If _option = 'fullscreen primary secondary' Then + Begin + m_primary_mode_fullscreen := SECONDARY; + Exit; + End; + If _option = 'center window' Then + Begin + m_center_window := True; + Exit; + End; + If _option = 'default window position' Then + Begin + m_center_window := False; + Exit; + End; + If _option = 'synchronized update' Then + Begin + m_synchronized_update := True; + Exit; + End; + If _option = 'unsynchronized update' Then + Begin + m_synchronized_update := False; + Exit; + End; + If _option = 'default nearest' Then + Begin + m_nearest_mode := NEAREST_DEFAULT; + Exit; + End; + If _option = 'center nearest' Then + Begin + m_nearest_mode := NEAREST_CENTERING; + Exit; + End; + If _option = 'default stretch' Then + Begin + m_nearest_mode := NEAREST_STRETCHING; + Exit; + End; + If _option = 'default cursor' Then + Begin + m_cursor_mode := CURSOR_DEFAULT; + update_cursor; + Exit; + End; + If _option = 'show cursor' Then + Begin + m_cursor_mode := CURSOR_SHOW; + update_cursor; + Exit; + End; + If _option = 'hide cursor' Then + Begin + m_cursor_mode := CURSOR_HIDE; + update_cursor; + Exit; + End; + If System.Copy(_option, 1, 9) = 'frequency' Then + Begin + If Length(_option) > 9 Then + Begin + Val(System.Copy(_option, 10, Length(_option)-9), m_frequency, tmp); + End + Else + m_frequency := 0; + End; + If _option = 'enable key buffering' Then + Begin + If m_keyboard = Nil Then + Begin + option := False; + Exit; + End; + m_keyboard.enable; + End; + If _option = 'disable key buffering' Then + Begin + If m_keyboard = Nil Then + Begin + option := False; + Exit; + End; + m_keyboard.disable; + End; + If _option = 'enable blocking' Then + Begin + m_primary.blocking(True); + Exit; + End; + If _option = 'disable blocking' Then + Begin + m_primary.blocking(False); + Exit; + End; +{$IFDEF PTC_LOGGING} + If _option = 'enable logging' Then + Begin + LOG_enabled := True; + option := True; + Exit; + End; + If _option = 'disable logging' Then + Begin + LOG_enabled := False; + option := True; + Exit; + End; +{$ENDIF} + + option := m_copy.option(_option); +End; + +Function TDirectXConsole.modes : PPTCMode; + +Begin + modes := m_display.modes; +End; + +Procedure TDirectXConsole.open(Const _title : String; _pages : Integer); + +Begin + open(_title, m_default_format, _pages); +End; + +Procedure TDirectXConsole.open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); + +Begin + open(_title, m_default_width, m_default_height, _format, _pages); +End; + +Procedure TDirectXConsole.open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); + +Var + m : TPTCMode; + +Begin + { internal open nearest mode } + m := TPTCMode.Create(_width, _height, _format); + Try + internal_open(_title, 0, m, _pages, False); + Finally + m.Free; + End; +End; + +Procedure TDirectXConsole.open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); + +Begin + { internal open exact mode } + internal_open(_title, 0, _mode, _pages, True); +End; + +Procedure TDirectXConsole.close; + +Begin + If m_open Then + Begin + If m_locked Then + Raise TPTCError.Create('console is still locked'); + + { flush all key presses } + While KeyPressed Do + ReadKey; + End; + internal_close; + Win32Cursor_resurrect; +End; + +Procedure TDirectXConsole.flush; + +Begin + CHECK_OPEN('TDirectXConsole.flush'); + CHECK_LOCK('TDirectXConsole.flush'); + { [platform dependent code to flush all console operations] } + + { handle cursor show flag } + If Not m_cursor Then + SetCursor(0); + + { update window } + m_window.update; +End; + +Procedure TDirectXConsole.finish; + +Begin + CHECK_OPEN('TDirectXConsole.finish'); + CHECK_LOCK('TDirectXConsole.finish'); + { [platform dependent code to finish all console operations] } + + { handle cursor show flag } + If Not m_cursor Then + SetCursor(0); + + { update window } + m_window.update; +End; + +Procedure TDirectXConsole.update; + +Begin + CHECK_OPEN('TDirectXConsole.update'); + CHECK_LOCK('TDirectXConsole.update'); + + { update primary surface } + m_primary.update; + + { handle cursor show flag } + If Not m_cursor Then + SetCursor(0); + + { update window } + m_window.update; +End; + +Procedure TDirectXConsole.update(Const _area : TPTCArea); + +Begin + { update } + update; +End; + +Procedure TDirectXConsole.internal_ReadKey(k : TPTCKey); + +Begin + CHECK_OPEN('TDirectXConsole.internal_ReadKey'); + m_keyboard.internal_ReadKey(m_window, k); +End; + +Function TDirectXConsole.internal_PeekKey(k : TPTCKey) : Boolean; + +Begin + CHECK_OPEN('TDirectXConsole.internal_PeekKey'); + Result := m_keyboard.internal_PeekKey(m_window, k); +End; + +Procedure TDirectXConsole.copy(Var surface : TPTCBaseSurface); + +Var + pixels : Pointer; + +Begin + CHECK_OPEN('TDirectXConsole.copy(surface)'); + CHECK_LOCK('TDirectXConsole.copy(surface)'); + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Procedure TDirectXConsole.copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); + +Var + pixels : Pointer; + +Begin + CHECK_OPEN('TDirectXConsole.flush(surface, source, destination)'); + CHECK_LOCK('TDirectXConsole.flush(surface, source, destination)'); + pixels := lock; + Try + surface.load(pixels, width, height, pitch, format, palette, source, destination); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to copy console to surface', error); + End; + End; +End; + +Function TDirectXConsole.lock : Pointer; + +Begin + CHECK_OPEN('TDirectXConsole.lock'); + { fail if the console is already locked } + If m_locked Then + Raise TPTCError.Create('console is already locked'); + + { lock primary surface } + lock := m_primary.lock; + + { surface is locked } + m_locked := True; +End; + +Procedure TDirectXConsole.unlock; + +Begin + CHECK_OPEN('TDirectXConsole.unlock'); + { fail if the console is not locked } + If Not m_locked Then + Raise TPTCError.Create('console is not locked'); + + { unlock primary surface } + m_primary.unlock; + + { we are unlocked } + m_locked := False; +End; + +Procedure TDirectXConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + CHECK_OPEN('TDirectXConsole.load(pixels, width, height, pitch, format, palette)'); + CHECK_LOCK('TDirectXConsole.load(pixels, width, height, pitch, format, palette)'); + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0, + width, height, pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + load(pixels, _width, _height, _pitch, _format, _palette, Area_, area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TDirectXConsole.load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + CHECK_OPEN('TDirectXConsole.load(pixels, width, height, pitch, format, palette, source, destination)'); + CHECK_LOCK('TDirectXConsole.load(pixels, width, height, pitch, format, palette, source, destination)'); + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination); + Finally + tmp.Free; + End; + m_copy.request(_format, format); + m_copy.palette(_palette, palette); + m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to load pixels to console area', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Free; + clipped_destination.Free; + End; +End; + +Procedure TDirectXConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + CHECK_OPEN('TDirectXConsole.save(pixels, width, height, pitch, format, palette)'); + CHECK_LOCK('TDirectXConsole.save(pixels, width, height, pitch, format, palette)'); + If clip.Equals(area) Then + Begin + console_pixels := lock; + Try + Try + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0, + _width, _height, _pitch); + Except + On error : TPTCError Do + Begin + Raise TPTCError.Create('failed to save console pixels', error); + End; + End; + Finally + unlock; + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + save(pixels, _width, _height, _pitch, _format, _palette, area, Area_); + Finally + Area_.Free; + End; + End; +End; + +Procedure TDirectXConsole.save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + CHECK_OPEN('TDirectXConsole.save(pixels, width, height, pitch, format, palette, source, destination)'); + CHECK_LOCK('TDirectXConsole.save(pixels, width, height, pitch, format, palette, source, destination)'); + clipped_destination := Nil; + clipped_source := TPTCArea.Create; + Try + clipped_destination := TPTCArea.Create; + console_pixels := lock; + Try + Try + tmp := TPTCArea.Create(0, 0, _width, _height); + Try + TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination); + Finally + tmp.Free; + End; + m_copy.request(format, _format); + m_copy.palette(palette, _palette); + m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch, + pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch); + Except + On error:TPTCError Do + Begin + Raise TPTCError.Create('failed to save console area pixels', error); + End; + End; + Finally + unlock; + End; + Finally + clipped_source.Free; + clipped_destination.Free; + End; +End; + +Procedure TDirectXConsole.clear; + +Var + tmp : TPTCColor; + +Begin + CHECK_OPEN('TDirectXConsole.clear'); + CHECK_LOCK('TDirectXConsole.clear'); + If format.direct Then + tmp := TPTCColor.Create(0, 0, 0, 0) + Else + tmp := TPTCColor.Create(0); + Try + clear(tmp); + Finally + tmp.Free; + End; +End; + +Procedure TDirectXConsole.clear(Const color : TPTCColor); + +Var + tmp : TPTCArea; + +Begin + CHECK_OPEN('TDirectXConsole.clear(color)'); + CHECK_LOCK('TDirectXConsole.clear(color)'); + tmp := TPTCArea.Create; + Try + clear(color, tmp); + Finally + tmp.Free; + End; +End; + +Procedure TDirectXConsole.clear(Const color : TPTCColor; + Const _area : TPTCArea); + +Begin + CHECK_OPEN('TDirectXConsole.clear(color, area)'); + CHECK_LOCK('TDirectXConsole.clear(color, area)'); + m_primary.clear(color, _area); +End; + +Procedure TDirectXConsole.palette(Const _palette : TPTCPalette); + +Begin + CHECK_OPEN('TDirectXConsole.palette(palette)'); + m_primary.palette(_palette); +End; + +Function TDirectXConsole.palette : TPTCPalette; + +Begin + CHECK_OPEN('TDirectXConsole.palette'); + palette := m_primary.palette; +End; + +Procedure TDirectXConsole.clip(Const _area : TPTCArea); + +Begin + CHECK_OPEN('TDirectXConsole.clip(area)'); + m_primary.clip(_area); +End; + +Function TDirectXConsole.width : Integer; + +Begin + CHECK_OPEN('TDirectXConsole.width'); + width := m_primary.width; +End; + +Function TDirectXConsole.height : Integer; + +Begin + CHECK_OPEN('TDirectXConsole.height'); + height := m_primary.height; +End; + +Function TDirectXConsole.pitch : Integer; + +Begin + CHECK_OPEN('TDirectXConsole.pitch'); + pitch := m_primary.pitch; +End; + +Function TDirectXConsole.pages : Integer; + +Begin + CHECK_OPEN('TDirectXConsole.pages'); + pages := m_primary.pages; +End; + +Function TDirectXConsole.area : TPTCArea; + +Begin + CHECK_OPEN('TDirectXConsole.area'); + area := m_primary.area; +End; + +Function TDirectXConsole.clip : TPTCArea; + +Begin + CHECK_OPEN('TDirectXConsole.clip'); + clip := m_primary.clip; +End; + +Function TDirectXConsole.format : TPTCFormat; + +Begin + CHECK_OPEN('TDirectXConsole.format'); + format := m_primary.format; +End; + +Function TDirectXConsole.name : String; + +Begin + name := 'DirectX'; +End; + +Function TDirectXConsole.title : String; + +Begin + CHECK_OPEN('TDirectXConsole.title'); + title := m_title; +End; + +Function TDirectXConsole.information : String; + +Begin + CHECK_OPEN('TDirectXConsole.information'); + information := m_display.information; +End; + +Procedure TDirectXConsole.internal_open(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + +Var + _width, _height : Integer; + _format : TPTCFormat; + +Begin + Try + { recycle an already open console } + internal_recycle(_title, window, mode, _pages, exact); + Exit; + Except + On TPTCError Do + { could not recycle }; + End; + + { check that the mode is valid } + If Not mode.valid Then + Raise TPTCError.Create('invalid mode'); + + { get mode information } + _width := mode.width; + _height := mode.height; + _format := mode.format; + + { start internal open } + internal_open_start(_title, window); + + { check output mode } + Case m_output_mode Of + DEFAULT : + Try + { start fullscreen open } + internal_open_fullscreen_start(window, mode, exact); + + { change fullscreen display } + internal_open_fullscreen_change(mode, exact); + + { setup fullscreen display surfaces } + internal_open_fullscreen_surface(mode, _pages); + + { finish fullscreen open } + internal_open_fullscreen_finish; + Except + On TPTCError Do + Begin + { internal open reset } + internal_open_reset; + + { start windowed open } + internal_open_windowed_start(window, mode, exact); + + { change windowed display display mode } + internal_open_windowed_change(mode, exact); + + { setup windowed display } + internal_open_windowed_surface(mode, _pages); + + { finish windowed open } + internal_open_windowed_finish; + End; + End; + WINDOWED : Begin + { start windowed open } + internal_open_windowed_start(window, mode, exact); + + { change windowed display display mode } + internal_open_windowed_change(mode, exact); + + { setup windowed display } + internal_open_windowed_surface(mode, _pages); + + { finish windowed open } + internal_open_windowed_finish; + End; + FULLSCREEN : Begin + { start fullscreen open } + internal_open_fullscreen_start(window, mode, exact); + + { change fullscreen display } + internal_open_fullscreen_change(mode, exact); + + { setup fullscreen display surfaces } + internal_open_fullscreen_surface(mode, _pages); + + { finish fullscreen open } + internal_open_fullscreen_finish; + End; + End; + + { finish internal open } + internal_open_finish; +End; + +Procedure TDirectXConsole.internal_recycle(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + +Begin + { Check if the console is open } + If not m_open Then + Raise TPTCError.Create('cannot recycle because it is not already open'); + If window <> 0 Then + Begin + If (m_window.handle <> window) Or (Not (m_window.managed)) Then + Raise TPTCError.Create('cannot recycle with this user window'); + End; + Case m_output_mode Of + DEFAULT : + If m_display.fullscreen Then + Begin + Try + internal_recycle_fullscreen(_title, window, mode, _pages, exact); + Except + On TPTCError Do + Raise TPTCError.Create('recycling fullscreen to windowed is not implemented'); + End; + End + Else + Raise TPTCError.Create('recycling windowed to fullscreen is not implemented'); + FULLSCREEN : internal_recycle_fullscreen(_title, window, mode, _pages, exact); + WINDOWED : internal_recycle_fullscreen(_title, window, mode, _pages, exact); + End; +End; + +Procedure TDirectXConsole.internal_close; + +Begin + m_open := False; + FreeAndNil(m_keyboard); + FreeAndNil(m_hook); + If m_primary <> Nil Then + m_primary.close; + If m_display <> Nil Then + m_display.close; + FreeAndNil(m_window); + If m_display <> Nil Then + m_display.restore; +End; + +Procedure TDirectXConsole.internal_shutdown; + +Begin + m_library.close; +End; + +Procedure TDirectXConsole.internal_open_start(Const _title : String; window : HWND); + +Var + tmp : Array[0..1023] Of Char; + +Begin + { close_down } + internal_close; + + { check window } + If window = 0 Then + Begin + m_title := _title; + End + Else + Begin + GetWindowText(window, @tmp, SizeOf(tmp)); + m_title := PChar2String(@tmp); + End; +End; + +Procedure TDirectXConsole.internal_open_finish; + +Begin + FreeAndNil(m_keyboard); + m_keyboard := TWin32Keyboard.Create(m_window.handle, m_window.thread, False); + m_window.update; + m_open := True; +End; + +Procedure TDirectXConsole.internal_open_reset; + +Begin + FreeAndNil(m_keyboard); + FreeAndNil(m_hook); + m_primary.close; + FreeAndNil(m_window); + m_display.restore; +End; + +Procedure TDirectXConsole.internal_open_fullscreen_start(window : HWND; Const mode : TPTCMode; exact : Boolean); + +Begin + { test if display mode exists... } + If Not m_display.test(mode, exact) Then + Raise TPTCError.Create('display mode test failed!'); + + { handle cursor show mode } + If m_cursor_mode = CURSOR_SHOW Then + m_cursor := True + Else + m_cursor := False; + + { save display } + m_display.save; + + { check window } + If window = 0 Then + m_window := TWin32Window.Create('PTC_DIRECTX_FULLSCREEN', m_title, WS_EX_TOPMOST, WS_POPUP Or WS_SYSMENU Or WS_VISIBLE, SW_NORMAL, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), False, False) + Else + m_window := TWin32Window.Create(window); + + { set window cursor } + m_window.cursor(m_cursor); + + { set cooperative level } + m_display.cooperative(m_window.handle, True); +End; + +Procedure TDirectXConsole.internal_open_fullscreen_change(Const mode : TPTCMode; exact : Boolean); + +Begin + m_display.open(mode, exact, m_frequency); + m_primary.blocking(True); +End; + +Procedure TDirectXConsole.internal_open_fullscreen_surface(Const mode : TPTCMode; _pages : Integer); + +Var + primary : Boolean; + _secondary : Boolean; + _palette : Boolean; + complex : Boolean; + +Begin + _secondary := (m_primary_mode_fullscreen = SECONDARY) Or (Not m_display.mode.Equals(mode)); + _palette := m_display.mode.format.indexed; + m_primary.initialize(m_window, m_library.lpDD2); + complex := False; + primary := False; + + { randy heit's primary setup } + While (Not primary) And (Not complex) Do + Begin + If _pages >= 1 Then + Try + m_primary.primary(_pages, True, True, _palette, complex); + primary := True; + Except + On TPTCError Do; + End; + If Not primary Then + Try + m_primary.primary(3, True, True, _palette, complex); + primary := True; + Except + On TPTCError Do + Try + m_primary.primary(2, True, True, _palette, complex); + primary := True; + Except + On TPTCError Do + Try + If Not _secondary Then + m_primary.primary(2, False, True, _palette, complex) + Else + m_primary.primary(1, False, True, _palette, complex); + primary := True; + Except + On TPTCError Do + complex := Not complex; + End; + End; + End; + End; + If _secondary Then + m_primary.secondary(mode.width, mode.height); + If m_nearest_mode = NEAREST_CENTERING Then + m_primary.centering(True); + If m_nearest_mode = NEAREST_STRETCHING Then + m_primary.centering(False); + { + original primary setup code (1.0.17) + ... + } + + m_primary.synchronize(m_synchronized_update); +End; + +Procedure TDirectXConsole.internal_open_fullscreen_finish; + +Begin + FreeAndNil(m_hook); + + { create hook on window } + m_hook := TDirectXHook.Create(Self, m_window.handle, GetCurrentThreadId, m_cursor, m_window.managed, True); +End; + +Procedure TDirectXConsole.internal_open_windowed_start(window : HWND; Const mode : TPTCMode; exact : Boolean); + +Var + extended : Integer; + +Begin + If m_cursor_mode = CURSOR_HIDE Then + m_cursor := False + Else + m_cursor := True; + FreeAndNil(m_window); + If window <> 0 Then + Begin + m_window := TWin32Window.Create(window); + End + Else + Begin + extended := 0; + If m_primary_mode_windowed = DIRECT Then + extended := WS_EX_TOPMOST; + Case m_window_mode Of + RESIZABLE : m_window := TWin32Window.Create('PTC_DIRECTX_WINDOWED_RESIZABLE', m_title, + extended, WS_OVERLAPPEDWINDOW Or WS_VISIBLE, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, m_center_window, False); + FIXED : m_window := TWin32Window.Create('PTC_DIRECTX_WINDOWED_FIXED', m_title, + extended, WS_VISIBLE Or WS_SYSMENU Or WS_CAPTION Or WS_MINIMIZE, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, m_center_window, False); + End; + End; + m_window.cursor(m_cursor); + m_display.cooperative(m_window.handle, False); +End; + +Procedure TDirectXConsole.internal_open_windowed_change(Const mode : TPTCMode; exact : Boolean); + +Begin + m_display.open; + If m_primary_mode_windowed = DIRECT Then + m_primary.blocking(True) + Else + m_primary.blocking(False); +End; + +Procedure TDirectXConsole.internal_open_windowed_surface(Const mode : TPTCMode; _pages : Integer); + +Begin + m_primary.initialize(m_window, m_library.lpDD2); + m_primary.primary(1, False, False, False, False); + If m_primary_mode_windowed = SECONDARY Then + m_primary.secondary(mode.width, mode.height); +End; + +Procedure TDirectXConsole.internal_open_windowed_finish; + +Begin + FreeAndNil(m_hook); + + { create hook on window } + m_hook := TDirectXHook.Create(Self, m_window.handle, GetCurrentThreadId, m_cursor, m_window.managed, False); +End; + +Procedure TDirectXConsole.internal_recycle_fullscreen(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + +Begin + LOG('fullscreen open recycle'); + m_primary.close; + internal_open_fullscreen_change(mode, exact); + internal_open_fullscreen_surface(mode, _pages); +End; + +Procedure TDirectXConsole.internal_recycle_windowed(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + +Begin + LOG('windowed open recycle'); + m_primary.close; + m_window.resize(mode.width, mode.height); + internal_open_windowed_change(mode, exact); + internal_open_windowed_surface(mode, _pages); +End; + +Procedure TDirectXConsole.paint; + +Begin + If m_locked Or (Not m_open) Then + Exit; + m_primary.paint; +End; + +Procedure TDirectXConsole.update_cursor; + +Begin + If Not m_open Then + Exit; + If m_display.fullscreen Then + If m_cursor_mode = CURSOR_SHOW Then + m_cursor := True + Else + m_cursor := False + Else + If m_cursor_mode = CURSOR_HIDE Then + m_cursor := False + Else + m_cursor := True; + + { update hook cursor } + m_hook.cursor(m_cursor); + + { update window cursor } + m_window.cursor(m_cursor); +End; + +{$IFDEF DEBUG} +Procedure TDirectXConsole.CHECK_OPEN(msg : String); + +Begin + If Not m_open Then + Try + Raise TPTCError.Create('console is not open'); + Except + On error : TPTCError Do + Raise TPTCError.Create(msg, error); + End; +End; + +Procedure TDirectXConsole.CHECK_LOCK(msg : String); + +Begin + If m_locked Then + Try + Raise TPTCError.Create('console is locked'); + Except + On error : TPTCError Do + Raise TPTCError.Create(msg, error); + End; +End; +{$ENDIF} diff --git a/packages/ptc/src/win32/directx/directxconsoled.inc b/packages/ptc/src/win32/directx/directxconsoled.inc new file mode 100644 index 0000000000..b0a893df0b --- /dev/null +++ b/packages/ptc/src/win32/directx/directxconsoled.inc @@ -0,0 +1,160 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TDirectXConsole = Class(TPTCBaseConsole) + Private + { internal console management routines } + Procedure internal_open(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + Procedure internal_recycle(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + Procedure internal_close; + Procedure internal_shutdown; + + { internal console open management routines } + Procedure internal_open_start(Const _title : String; window : HWND); + Procedure internal_open_finish; + Procedure internal_open_reset; + + { internal fullscreen open routines } + Procedure internal_open_fullscreen_start(window : HWND; Const mode : TPTCMode; exact : Boolean); + Procedure internal_open_fullscreen_change(Const mode : TPTCMode; exact : Boolean); + Procedure internal_open_fullscreen_surface(Const mode : TPTCMode; _pages : Integer); + Procedure internal_open_fullscreen_finish; + + { internal windowed open routines } + Procedure internal_open_windowed_start(window : HWND; Const mode : TPTCMode; exact : Boolean); + Procedure internal_open_windowed_change(Const mode : TPTCMode; exact : Boolean); + Procedure internal_open_windowed_surface(Const mode : TPTCMode; _pages : Integer); + Procedure internal_open_windowed_finish; + + { internal console open recycling routines } + Procedure internal_recycle_fullscreen(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + Procedure internal_recycle_windowed(Const _title : String; window : HWND; Const mode : TPTCMode; _pages : Integer; exact : Boolean); + +{$IFDEF DEBUG} + { debug } + Procedure CHECK_OPEN(msg : String); + Procedure CHECK_LOCK(msg : String); +{$ENDIF} + + { painting } + Procedure paint; + + { cursor state } + Procedure update_cursor; + + { title data } +{ m_title : Array[0..1023] Of Char;} + m_title : AnsiString; + + { flags } + m_open : Boolean; + m_locked : Boolean; + m_cursor : Boolean; + + { option data } + m_frequency : Integer; + m_default_width : Integer; + m_default_height : Integer; + m_default_pages : Integer; + m_center_window : Boolean; + m_synchronized_update : Boolean; + m_default_format : TPTCFormat; + m_output_mode : Integer; {Output} + m_window_mode : Integer; {Window} + m_primary_mode_windowed : Integer; {Primary} + m_primary_mode_fullscreen : Integer; {Primary} + m_nearest_mode : Integer; {Nearest} + m_cursor_mode : Integer; {Cursor} + + { objects } + m_copy : TPTCCopy; + + { Win32 objects } + m_window : TWin32Window; + m_keyboard : TWin32Keyboard; + + { DirectX objects } + m_hook : TDirectXHook; + m_library : TDirectXLibrary; + m_display : TDirectXDisplay; + m_primary : TDirectXPrimary; + Protected + Procedure internal_ReadKey(k : TPTCKey); Override; + Function internal_PeekKey(k : TPTCKey) : Boolean; Override; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure configure(Const _file : String); Override; + Function option(Const _option : String) : Boolean; Override; + Function modes : PPTCMode; Override; + Procedure open(Const _title : String; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _format : TPTCFormat; + _pages : Integer); Overload; Override; + Procedure open(Const _title : String; _width, _height : Integer; + Const _format : TPTCFormat; _pages : Integer); Overload; Override; + Procedure open(Const _title : String; Const _mode : TPTCMode; + _pages : Integer); Overload; Override; + Procedure close; Override; + Procedure flush; Override; + Procedure finish; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Procedure copy(Var surface : TPTCBaseSurface); Override; + Procedure copy(Var surface : TPTCBaseSurface; + Const source, destination : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure load(Const pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette); Override; + Procedure save(pixels : Pointer; + _width, _height, _pitch : Integer; + Const _format : TPTCFormat; + Const _palette : TPTCPalette; + Const source, destination : TPTCArea); Override; + Procedure clear; Override; + Procedure clear(Const color : TPTCColor); Override; + Procedure clear(Const color : TPTCColor; + Const _area : TPTCArea); Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function palette : TPTCPalette; Override; + Procedure clip(Const _area : TPTCArea); Override; + Function width : Integer; Override; + Function height : Integer; Override; + Function pitch : Integer; Override; + Function pages : Integer; Override; + Function area : TPTCArea; Override; + Function clip : TPTCArea; Override; + Function format : TPTCFormat; Override; + Function name : String; Override; + Function title : String; Override; + Function information : String; Override; + End; diff --git a/packages/ptc/src/win32/directx/display.inc b/packages/ptc/src/win32/directx/display.inc new file mode 100644 index 0000000000..615ee4239e --- /dev/null +++ b/packages/ptc/src/win32/directx/display.inc @@ -0,0 +1,630 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TDirectXDisplay.Create; + +Begin + m_information := ''; + m_mode := Nil; + m_cursorsaved := False; + m_open := False; + m_fullscreen := False; + m_ddraw := Nil; + m_window := 0; +// m_foreground := 0; + FillChar(m_modes, SizeOf(m_modes), 0); + FillChar(m_resolutions, SizeOf(m_resolutions), 0); + m_mode := TPTCMode.Create; +End; + +Destructor TDirectXDisplay.Destroy; + +Begin + close; + m_mode.Free; + internal_dispose_modes; + internal_dispose_resolutions; + Inherited Destroy; +End; + +Procedure TDirectXDisplay.internal_dispose_modes; + +Var + i : Integer; + +Begin + For i := Low(m_modes) To High(m_modes) Do + FreeAndNil(m_modes[i]); +End; + +Procedure TDirectXDisplay.internal_dispose_resolutions; + +Var + i : Integer; + +Begin + For i := Low(m_resolutions) To High(m_resolutions) Do + FreeAndNil(m_resolutions[i]); +End; + +Function TDirectXDisplay_callback(descriptor : LPDDSURFACEDESC; Context : Pointer) : HRESULT; StdCall; + +Var + display : TDirectXDisplay; + tmp : TPTCFormat; + +Begin + If (descriptor = Nil) Or (Context = Nil) Then + Begin + TDirectXDisplay_callback := DDENUMRET_CANCEL; + Exit; + End; + display := TDirectXDisplay(Context); + If ((descriptor^.dwFlags And DDSD_WIDTH) <> 0) And + ((descriptor^.dwFlags And DDSD_HEIGHT) <> 0) And + ((descriptor^.dwFlags And DDSD_PIXELFORMAT) <> 0) Then + Begin + tmp := DirectXTranslate(descriptor^.ddpfPixelFormat); + Try + FreeAndNil(display.m_modes[display.m_modes_count]); + display.m_modes[display.m_modes_count] := + TPTCMode.Create(descriptor^.dwWidth, descriptor^.dwHeight, tmp); + Finally + tmp.Free; + End; + Inc(display.m_modes_count); + End + Else + Begin + LOG('EnumDisplayModesCallback was not given enough mode information'); + End; + TDirectXDisplay_callback := DDENUMRET_OK; +End; + +Procedure TDirectXDisplay.setup(ddraw : LPDIRECTDRAW2); + +Var + version : OSVERSIONINFO; + match, found : Boolean; + i, j : Integer; + temp : TPTCMode; + temp2 : TPTCFormat; + S, S2 : String; + +Begin + LOG('setting up display lpDD2'); + m_ddraw := ddraw; + m_information := 'windows version x.xx.x' + #13 + #10 + 'ddraw version x.xx' + #13 + #10 + 'display driver name xxxxx' + + #13 + #10 + 'display driver vendor xxxxx' + #13 + #10 + 'certified driver? x' + #13 + #10; + m_modes_count := 0; + DirectXCheck(m_ddraw^.lpVtbl^.EnumDisplayModes(m_ddraw, 0, Nil, {this}Self, LPDDENUMMODESCALLBACK(@TDirectXDisplay_callback))); + version.dwOSVersionInfoSize := SizeOf(version); + If GetVersionEx(version) Then + Begin + If version.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then + Begin + LOG('detected windows 95/98'); + temp2 := TPTCFormat.Create(8); + Try + found := False; + For i := 0 To m_modes_count - 1 Do + If (m_modes[i].width = 320) And (m_modes[i].height = 200) And + m_modes[i].format.Equals(temp2) Then + found := True; + If Not found Then + Begin + LOG('adding 320x200x8 to mode list'); + FreeAndNil(m_modes[m_modes_count]); + m_modes[m_modes_count] := TPTCMode.Create(320, 200, temp2); + Inc(m_modes_count); + End; + found := False; + For i := 0 To m_modes_count - 1 Do + If (m_modes[i].width = 320) And (m_modes[i].height = 240) And + m_modes[i].format.Equals(temp2) Then + found := True; + If Not found Then + Begin + LOG('adding 320x240x8 to mode list'); + FreeAndNil(m_modes[m_modes_count]); + m_modes[m_modes_count] := TPTCMode.Create(320, 240, temp2); + Inc(m_modes_count); + End; + Finally + temp2.Free; + End; + End + Else + If version.dwPlatformId = VER_PLATFORM_WIN32_NT Then + Begin + LOG('detected windows nt'); + End; + End; + LOG('number of display modes', m_modes_count); + FreeAndNil(m_modes[m_modes_count]); + m_modes[m_modes_count] := TPTCMode.Create; + m_resolutions_count := 0; + For i := 0 To m_modes_count - 1 Do + Begin + match := False; + For j := 0 To m_resolutions_count - 1 Do + If (m_modes[i].width = m_resolutions[j].width) And + (m_modes[i].height = m_resolutions[j].height) Then + Begin + match := True; + Break; + End; + If Not match Then + Begin + FreeAndNil(m_resolutions[m_resolutions_count]); + m_resolutions[m_resolutions_count] := TPTCMode.Create(m_modes[i]); + Inc(m_resolutions_count); + End; + End; + FreeAndNil(m_resolutions[m_resolutions_count]); + m_resolutions[m_resolutions_count] := TPTCMode.Create; + + { kludge sort... :) } + For i := 0 To m_resolutions_count - 1 Do + For j := i + 1 To m_resolutions_count - 1 Do + If (m_resolutions[i].width > m_resolutions[j].width) Or + (m_resolutions[i].height > m_resolutions[j].height) Then + Begin + temp := m_resolutions[i]; + m_resolutions[i] := m_resolutions[j]; + m_resolutions[j] := temp; + End; + LOG('number of unique resolutions', m_resolutions_count); + For i := 0 To m_resolutions_count - 1 Do + Begin + Str(m_resolutions[i].width, S); + Str(m_resolutions[i].height, S2); + LOG(S + ' x ' + S2); + End; +End; + +Function TDirectXDisplay.modes : PPTCMode; + +Begin + modes := @m_modes; +End; + +Function TDirectXDisplay.test(Const _mode : TPTCMode; exact : Boolean) : Boolean; + +Var + i : Integer; + +Begin + If m_modes_count = 0 Then + Begin + LOG('mode test success with empty mode list'); + test := True; + Exit; + End; + If exact Then + Begin + For i := 0 To m_modes_count - 1 Do + If m_modes[i].Equals(_mode) Then + Begin + LOG('test exact mode success'); + test := True; + Exit; + End; + LOG('test exact mode failure'); + test := False; + End + Else + Begin + For i := 0 To m_resolutions_count - 1 Do + If (_mode.width <= m_resolutions[i].width) And + (_mode.height <= m_resolutions[i].height) Then + Begin + LOG('test nearest mode success'); + test := True; + Exit; + End; + LOG('test nearest mode failure'); + test := False; + End; +End; + +Procedure TDirectXDisplay.cooperative(window : HWND; _fullscreen : Boolean); + +Begin + If _fullscreen Then + Begin + LOG('entering exclusive mode'); + DirectXCheck(m_ddraw^.lpVtbl^.SetCooperativeLevel(m_ddraw, window, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX)); + End + Else + Begin + LOG('entering normal cooperative mode'); + DirectXCheck(m_ddraw^.lpVtbl^.SetCooperativeLevel(m_ddraw, window, DDSCL_NORMAL)); + End; + m_window := window; + m_fullscreen := _fullscreen; +End; + +Procedure TDirectXDisplay.open; + +Begin + FreeAndNil(m_mode); + m_mode := TPTCMode.Create; + m_open := True; + LOG('opening windowed display'); +End; + +Procedure TDirectXDisplay.open(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + +Begin + If exact Then + Begin + LOG('opening exact fullscreen display mode'); + internal_open(_mode, True, frequency); + End + Else + Begin + LOG('opening nearest fullscreen mode'); + internal_open_nearest(_mode, False, frequency); + End; + LOG('successfully opened fullscreen display mode'); +End; + +Procedure TDirectXDisplay.close; + +Begin + If m_open And (m_ddraw <> Nil) Then + Begin + LOG('closing display'); + If m_fullscreen Then + Begin + LOG('restoring display mode'); + m_ddraw^.lpVtbl^.RestoreDisplayMode(m_ddraw); + LOG('leaving exclusive mode'); + m_ddraw^.lpVtbl^.SetCooperativeLevel(m_ddraw, m_window, DDSCL_NORMAL); + End; + End; + m_open := False; + m_fullscreen := False; +End; + +Procedure TDirectXDisplay.save; + +Var + p : POINT; + +Begin + LOG('saving desktop'); + + m_cursorsaved := GetCursorPos(p); + m_cursorX := p.x; + m_cursorY := p.y; + +{ m_foreground := GetForegroundWindow; + GetWindowRect(m_foreground, m_foreground_rect); + m_foreground_placement.length := SizeOf(WINDOWPLACEMENT); + GetWindowPlacement(m_foreground, m_foreground_placement);} +End; + +Procedure TDirectXDisplay.restore; + +Begin +{ If (m_foreground <> 0) And IsWindow(m_foreground) And (m_foreground <> m_window) Then + Begin} + LOG('restoring desktop'); + If IsWindow(m_window) And m_fullscreen Then + SetWindowPos(m_window, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE); + If m_cursorsaved Then + Begin + SetCursorPos(m_cursorX, m_cursorY); + m_cursorsaved := False; + End; +{ SetForegroundWindow(m_foreground); + SetWindowPlacement(m_foreground, m_foreground_placement); + SetWindowPos(m_foreground, HWND_TOP, m_foreground_rect.left, m_foreground_rect.top, m_foreground_rect.right - m_foreground_rect.left, m_foreground_rect.bottom - m_foreground_rect.top, SWP_FRAMECHANGED Or SWP_NOCOPYBITS); + m_foreground := 0; + End;} +End; + +Function TDirectXDisplay.mode : TPTCMode; + +Begin + mode := m_mode; +End; + +Function TDirectXDisplay.fullscreen : Boolean; + +Begin + fullscreen := m_fullscreen; +End; + +Function TDirectXDisplay.information : String; + +Begin + information := m_information; +End; + +Procedure TDirectXDisplay.internal_open(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + +Begin + LOG('internal display open'); + LOG('mode width', _mode.width); + LOG('mode height', _mode.height); + LOG('mode format', _mode.format); + LOG('mode frequency', frequency); + If exact Then + Begin + LOG('setting exact mode'); + DirectXCheck(m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, _mode.format.bits, frequency, 0)); + End + Else + Case _mode.format.bits Of + 32 : Begin + LOG('setting virtual 32 mode'); + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 32, frequency, 0) <> DD_OK Then + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 24, frequency, 0) <> DD_OK Then + DirectXCheck(m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 16, frequency, 0)); + End; + 24 : Begin + LOG('setting virtual 24 mode'); + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 24, frequency, 0) <> DD_OK Then + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 32, frequency, 0) <> DD_OK Then + DirectXCheck(m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 16, frequency, 0)); + End; + 16 : Begin + LOG('setting virtual 16 mode'); + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 16, frequency, 0) <> DD_OK Then + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 24, frequency, 0) <> DD_OK Then + DirectXCheck(m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 32, frequency, 0)); + End; + 8 : Begin + LOG('setting virtual 8 mode'); + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 8, frequency, 0) <> DD_OK Then + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 24, frequency, 0) <> DD_OK Then {yes, 24bit is now faster than 32bit!} + If m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 32, frequency, 0) <> DD_OK Then + DirectXCheck(m_ddraw^.lpVtbl^.SetDisplayMode(m_ddraw, _mode.width, _mode.height, 16, frequency, 0)); + End; + Else + Raise TPTCError.Create('unsupported pixel format'); + End; + LOG('internal display open success'); + FreeAndNil(m_mode); + m_mode := TPTCMode.Create(_mode); + m_open := True; +End; + +Procedure TDirectXDisplay.internal_open_nearest(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + +Var + index : Integer; + match, match_exact : TPTCMode; + tmp : TPTCMode; + i : Integer; + width, height : Integer; + dx1, dy1, dx2, dy2 : Integer; + +Begin + If m_resolutions_count <> 0 Then + Begin + LOG('searching for nearest mode in resolutions list'); + index := 0; + match_exact := Nil; + match := TPTCMode.Create; + Try + match_exact := TPTCMode.Create; + For i := 0 To m_resolutions_count - 1 Do + Begin + width := m_resolutions[i].width; + height := m_resolutions[i].height; + If (_mode.width <= width) And (_mode.height <= height) Then + Begin + If (width = _mode.width) And (height = _mode.height) Then + Begin + LOG('found an exact match'); + tmp := TPTCMode.Create(width, height, _mode.format); + Try + match_exact.ASSign(tmp); + Finally + tmp.Free; + End; + End; + If match.valid Then + Begin + dx1 := match.width - _mode.width; + dy1 := match.height - _mode.height; + dx2 := width - _mode.width; + dy2 := height - _mode.height; + If (dx2 <= dx1) And (dy2 <= dy1) Then + Begin + LOG('found a better nearest match'); + tmp := TPTCMode.Create(width, height, _mode.format); + Try + match.ASSign(tmp); + Finally + tmp.Free; + End; + End; + End + Else + Begin + LOG('found first nearest match'); + tmp := TPTCMode.Create(width, height, _mode.format); + Try + match.ASSign(tmp); + Finally + tmp.Free; + End; + End; + End + Else + Begin +{ LOG('stopping nearest mode search'); + Break;} + End; + End; + + If match_exact.valid Then + Try + LOG('trying an exact match'); + internal_open(match_exact, exact, frequency); + Exit; + Except + On TPTCError Do; + End; + If match.valid Then + Try + LOG('trying nearest match'); + internal_open(match, exact, frequency); + Exit; + Except + On TPTCError Do; + End; + Finally + match.Free; + match_exact.Free; + End; + End + Else + Begin + LOG('no resolutions list for nearest mode search'); + End; +{ match.Free; + match_exact.Free;} + LOG('could not find a nearest match in first pass'); + Try + LOG('trying requested mode first'); + internal_open(_mode, exact, frequency); + Exit; + Except + On TPTCError Do + Begin + LOG('falling back to nearest standard mode'); + If (_mode.width <= 320) And (_mode.height <= 200) Then + Try + tmp := TPTCMode.Create(320, 200, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 320) And (_mode.height <= 240) Then + Try + tmp := TPTCMode.Create(320, 240, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 512) And (_mode.height <= 384) Then + Try + tmp := TPTCMode.Create(512, 384, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 640) And (_mode.height <= 400) Then + Try + tmp := TPTCMode.Create(640, 400, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 640) And (_mode.height <= 480) Then + Try + tmp := TPTCMode.Create(640, 480, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 800) And (_mode.height <= 600) Then + Try + tmp := TPTCMode.Create(800, 600, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 1024) And (_mode.height <= 768) Then + Try + tmp := TPTCMode.Create(1024, 768, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 1280) And (_mode.height <= 1024) Then + Try + tmp := TPTCMode.Create(1280, 1024, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + If (_mode.width <= 1600) And (_mode.height <= 1200) Then + Try + tmp := TPTCMode.Create(1600, 1200, _mode.format); + Try + internal_open(tmp, exact, frequency); + Finally + tmp.Free; + End; + Exit; + Except + On TPTCError Do; + End; + End; + End; + Raise TPTCError.Create('could not set display mode'); +End; diff --git a/packages/ptc/src/win32/directx/displayd.inc b/packages/ptc/src/win32/directx/displayd.inc new file mode 100644 index 0000000000..72ca5800fd --- /dev/null +++ b/packages/ptc/src/win32/directx/displayd.inc @@ -0,0 +1,59 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TDirectXDisplay = Class(TObject) + Private + Procedure internal_open(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + Procedure internal_open_nearest(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + Procedure internal_dispose_modes; + Procedure internal_dispose_resolutions; + m_open : Boolean; + m_fullscreen : Boolean; + m_mode : TPTCMode; + m_window : HWND; + m_ddraw : LPDIRECTDRAW2; + m_modes_count : Integer; + m_resolutions_count : Integer; + m_modes : Array[0..255] Of TPTCMode; + m_resolutions : Array[0..255] Of TPTCMode; + m_information : String; + + m_cursorsaved : Boolean; + m_cursorX, m_cursorY : Integer; +{ m_foreground : HWND; + m_foreground_rect : RECT; + m_foreground_placement : WINDOWPLACEMENT;} + Public + Constructor Create; + Destructor Destroy; Override; + Procedure setup(ddraw : LPDIRECTDRAW2); + Function modes : PPTCMode; + Function test(Const _mode : TPTCMode; exact : Boolean) : Boolean; + Procedure cooperative(window : HWND; _fullscreen : Boolean); + Procedure open; + Procedure open(Const _mode : TPTCMode; exact : Boolean; frequency : Integer); + Procedure close; + Procedure save; + Procedure restore; + Function mode : TPTCMode; + Function fullscreen : Boolean; + Function information : String; + End; diff --git a/packages/ptc/src/win32/directx/hook.inc b/packages/ptc/src/win32/directx/hook.inc new file mode 100644 index 0000000000..d5ee8cfe79 --- /dev/null +++ b/packages/ptc/src/win32/directx/hook.inc @@ -0,0 +1,206 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TDirectXHook.Create(console : Pointer; window : HWND; thread : DWord; _cursor, managed, fullscreen : Boolean); + +Begin + m_console := console; + + m_cursor := _cursor; + m_managed := managed; + m_fullscreen := fullscreen; + + LOG('creating window hook'); + + Inherited Create(window, thread); +End; + +Destructor TDirectXHook.Destroy; + +Begin + LOG('destroying window hook'); + Inherited Destroy; +End; + +Procedure TDirectXHook.cursor(flag : Boolean); + +Begin + m_cursor := flag; +End; + +Function TDirectXHook.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + +Var + active : Boolean; + thread : DWord; + placement : WINDOWPLACEMENT; + console : TDirectXConsole; + +Begin + Case message Of + WM_PAINT : Begin + LOG('TDirectXHook WM_PAINT'); + + { paint console } + TDirectXConsole(m_console).paint; + End; + WM_ACTIVATEAPP : Begin + LOG('TDirectXHook WM_ACTIVATEAPP'); + + { get window message data } + active := Boolean(wParam); + thread := lParam; + + { check active flag } + If active = False Then + Begin + { deactivate } + deactivate; + + { check cursor and fullscreen } + If (Not m_cursor) And m_fullscreen Then + { show cursor } + Win32Cursor_resurrect; + End + Else + Begin + { check cursor and fullscreen } + If (Not m_cursor) And m_fullscreen Then + Begin + { get window placement for active app } + If Not GetWindowPlacement(hWnd, placement) Then + { on failure set to normal show } + placement.showCmd := SW_SHOWNORMAL; + + { check show command is not minimize } + If placement.showCmd <> SW_SHOWMINIMIZED Then + {hide cursor} + Win32Cursor_kill; + End; + + { activate } + activate; + End; + + { handled } + WndProc := 1; + Exit; + End; + WM_SETCURSOR : Begin + { check cursor } + If Not m_cursor Then + { hide cursor } + SetCursor(12); + + { handled } + WndProc := 1; + Exit; + End; + WM_CLOSE : Begin + LOG('TDirectXHook WM_CLOSE'); + + If m_managed Then + Begin + console := TDirectXConsole(m_console); + + { close console } + console.close; + + { note: at this point the hook object has been destroyed by the console! } + + { internal console shutdown } + console.internal_shutdown; + + { halt } + Halt(0); + End; + + { handled } + WndProc := 1; + Exit; + End; + End; + + { unhandled } + WndProc := 0; +End; + +Procedure TDirectXHook.activate; + +Var + console : TDirectXConsole; + display : TDirectXDisplay; + primary : TDirectXPrimary; + +Begin + console := TDirectXConsole(m_console); + { check if open } + If console.m_open Then + Begin + LOG('activate'); + + { get console object references } + display := console.m_display; + primary := console.m_primary; + + { check if primary is not active } + If Not primary.active Then + Begin + { save display } + display.save; + + { activate primary } + primary.activate; + End; + End; +End; + +Procedure TDirectXHook.deactivate; + +Var + console : TDirectXConsole; + display : TDirectXDisplay; + primary : TDirectXPrimary; + +Begin + console := TDirectXConsole(m_console); + { check if open } + If console.m_open Then + Begin + LOG('deactivate'); + + { get console object references } + display := console.m_display; + primary := console.m_primary; + + { check if primary is not active } + If primary.active Then + Begin + { save primary } + primary.save; + + { deactivate primary } + primary.deactivate; + + { restore display } + display.restore; + End; + End; +End; diff --git a/packages/ptc/src/win32/directx/hookd.inc b/packages/ptc/src/win32/directx/hookd.inc new file mode 100644 index 0000000000..b5590442d6 --- /dev/null +++ b/packages/ptc/src/win32/directx/hookd.inc @@ -0,0 +1,43 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TDirectXHook = Class(TWin32Hook) + Private + { console } + m_cursor : Boolean; + m_managed : Boolean; + m_fullscreen : Boolean; + m_console : Pointer; + Protected + { window procedure } + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override; + + { window management } + Procedure activate; + Procedure deactivate; + Public + { setup } + Constructor Create(console : Pointer; window : HWND; thread : DWord; _cursor, managed, fullscreen : Boolean); + Destructor Destroy; Override; + + { cursor management } + Procedure cursor(flag : Boolean); + End; diff --git a/packages/ptc/src/win32/directx/library.inc b/packages/ptc/src/win32/directx/library.inc new file mode 100644 index 0000000000..48ec130977 --- /dev/null +++ b/packages/ptc/src/win32/directx/library.inc @@ -0,0 +1,100 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TDirectXLibrary.Create; + +Var + DirectDrawCreate : TDirectDrawCreate; + IID_IDirectDraw2 : GUID; + +Begin + { defaults } + m_lpDD := Nil; + m_lpDD2 := Nil; + m_library := 0; + + Try + LOG('loading ddraw.dll'); + m_library := LoadLibrary('ddraw.dll'); + If m_library = 0 Then + Raise TPTCError.Create('could not load ddraw.dll'); + LOG('importing DirectDrawCreate'); + DirectDrawCreate := TDirectDrawCreate(GetProcAddress(m_library, 'DirectDrawCreate')); + If DirectDrawCreate = Nil Then + Raise TPTCError.Create('could not get address of DirectDrawCreate'); + LOG('creating lpDD'); + DirectXCheck(DirectDrawCreate(Nil, @m_lpDD, Nil)); + With IID_IDirectDraw2 Do + Begin + Data1 := $B3A6F3E0; + Data2 := $2B43; + Data3 := $11CF; + Data4[0] := $A2; + Data4[1] := $DE; + Data4[2] := $00; + Data4[3] := $AA; + Data4[4] := $00; + Data4[5] := $B9; + Data4[6] := $33; + Data4[7] := $56; + End; + LOG('querying lpDD2'); + DirectXCheck(m_lpDD^.lpVtbl^.QueryInterface(m_lpDD, @IID_IDirectDraw2, @m_lpDD2)); + Except + On error : TPTCError Do + Begin + { close } + close; + + { rethrow } + Raise TPTCError.Create('could not initialize ddraw', error); + End; + End; +End; + +Destructor TDirectXLibrary.Destroy; + +Begin + close; + Inherited Destroy; +End; + +Procedure TDirectXLibrary.close; + +Begin + If m_lpDD2 <> Nil Then + Begin + LOG('releasing lpDD2'); + m_lpDD2^.lpVtbl^.Release(m_lpDD2); + m_lpDD2 := Nil; + End; + If m_lpDD <> Nil Then + Begin + LOG('releasing lpDD'); + m_lpDD^.lpVtbl^.Release(m_lpDD); + m_lpDD := Nil; + End; + If m_library <> 0 Then + Begin + LOG('closing ddraw.dll'); + FreeLibrary(m_library); + m_library := 0; + End; +End; diff --git a/packages/ptc/src/win32/directx/libraryd.inc b/packages/ptc/src/win32/directx/libraryd.inc new file mode 100644 index 0000000000..fd84098f22 --- /dev/null +++ b/packages/ptc/src/win32/directx/libraryd.inc @@ -0,0 +1,33 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TDirectXLibrary = Class(TObject) + Private + m_library : HMODULE; + m_lpDD : LPDIRECTDRAW; + m_lpDD2 : LPDIRECTDRAW2; + Public + Constructor Create; + Destructor Destroy; Override; + Procedure close; + Property lpDD : LPDIRECTDRAW read m_lpDD; + Property lpDD2 : LPDIRECTDRAW2 read m_lpDD2; + End; diff --git a/packages/ptc/src/win32/directx/primary.inc b/packages/ptc/src/win32/directx/primary.inc new file mode 100644 index 0000000000..b58537e52e --- /dev/null +++ b/packages/ptc/src/win32/directx/primary.inc @@ -0,0 +1,966 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TDirectXPrimary.Create; + +Begin + m_area := Nil; + m_clip := Nil; + m_format := Nil; + m_clear := Nil; + m_palette := Nil; + m_area := TPTCArea.Create; + m_clip := TPTCArea.Create; + m_format := TPTCFormat.Create; + m_clear := TPTCClear.Create; + m_palette := TPTCPalette.Create; + + m_locked := Nil; + m_window := Nil; + m_width := 0; + m_height := 0; + m_back := Nil; + m_front := Nil; + m_pages := 0; + m_lpDD2 := Nil; + m_lpDDC := Nil; + m_lpDDS_primary := Nil; + m_lpDDS_primary_back := Nil; + m_lpDDS_secondary := Nil; + m_active := True; + m_blocking := True; + m_centering := True; + m_synchronize := True; + m_fullscreen := False; + m_primary_width := 0; + m_primary_height := 0; + m_secondary_width := 0; + m_secondary_height := 0; + FillChar(m_lpDDS_primary_page, SizeOf(m_lpDDS_primary_page), 0); +End; + +Destructor TDirectXPrimary.Destroy; + +Begin + { close } + close; + m_area.Free; + m_clip.Free; + m_format.Free; + m_clear.Free; + m_palette.Free; + Inherited Destroy; +End; + +Procedure TDirectXPrimary.initialize(window : TWin32Window; lpDD2 : LPDIRECTDRAW2); + +Begin + LOG('initializing primary surface'); + close; + m_window := window; + m_lpDD2 := lpDD2; +End; + +Procedure TDirectXPrimary.primary(_pages : Integer; video, fullscreen, _palette, complex : Boolean); + +Var + attach_primary_pages : Boolean; + descriptor : DDSURFACEDESC; + ddpf : DDPIXELFORMAT; + capabilities : DDSCAPS; + tmp : TPTCPalette; + i : Integer; + rectangle : RECT; + +Begin + Try + LOG('creating primary surface'); + LOG('pages', _pages); + LOG('video', video); + LOG('fullscreen', fullscreen); + LOG('palette', _palette); + LOG('complex', complex); + If _pages <= 0 Then + Raise TPTCError.Create('invalid number of pages'); + m_fullscreen := fullscreen; + attach_primary_pages := False; + If complex Or (Not _palette) Or (_pages = 1) Then + Begin + LOG('creating a complex primary flipping surface'); + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + descriptor.dwFlags := DDSD_CAPS; + If _pages > 1 Then + descriptor.dwFlags := descriptor.dwFlags Or DDSD_BACKBUFFERCOUNT; + descriptor.dwBackBufferCount := _pages - 1; + descriptor.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE; + If video Then + descriptor.ddsCaps.dwCaps := descriptor.ddsCaps.dwCaps Or DDSCAPS_VIDEOMEMORY; + If _pages > 1 Then + descriptor.ddsCaps.dwCaps := descriptor.ddsCaps.dwCaps Or DDSCAPS_COMPLEX Or DDSCAPS_FLIP; + DirectXCheck(m_lpDD2^.lpVtbl^.CreateSurface(m_lpDD2, @descriptor, @m_lpDDS_primary, Nil), 'm_lpDD2^.CreateSurface failed in TDirectXPrimary.primary'); + End + Else + Begin + LOG('creating a simple primary surface'); + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + descriptor.dwFlags := DDSD_CAPS; + descriptor.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE; + If video Then + descriptor.ddsCaps.dwCaps := descriptor.ddsCaps.dwCaps Or DDSCAPS_VIDEOMEMORY; + DirectXCheck(m_lpDD2^.lpVtbl^.CreateSurface(m_lpDD2, @descriptor, @m_lpDDS_primary, Nil), 'm_lpDD2^.CreateSurface failed in TDirectXPrimary.primary (palette)'); + attach_primary_pages := True; + End; + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + DirectXCheck(m_lpDDS_primary^.lpVtbl^.GetSurfaceDesc(m_lpDDS_primary, @descriptor), 'm_lpDDS_primary^.GetSurfaceDesc failed in TDirectXPrimary.primary'); + If (descriptor.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY) <> 0 Then + Begin + LOG('primary surface is in video memory'); + End + Else + Begin + LOG('primary surface is in system memory'); + End; + FillChar(ddpf, SizeOf(ddpf), 0); + ddpf.dwSize := SizeOf(ddpf); + DirectXCheck(m_lpDDS_primary^.lpVtbl^.GetPixelFormat(m_lpDDS_primary, @ddpf), 'm_lpDDS_primary^.GetPixelFormat failed in TDirectXPrimary.primary'); + m_front := m_lpDDS_primary; + m_pages := _pages; + m_width := descriptor.dwWidth; + m_height := descriptor.dwHeight; + FreeAndNil(m_format); + m_format := DirectXTranslate(ddpf); + LOG('primary width', m_width); + LOG('primary height', m_height); + LOG('primary pages', m_pages); + LOG('primary format', m_format); + If _palette Then + Begin + LOG('clearing primary palette'); + tmp := TPTCPalette.Create; + Try + palette(tmp); + Finally + tmp.Free; + End; + End; + If attach_primary_pages Then + Begin + If (_pages - 1) > High(m_lpDDS_primary_page) Then + Raise TPTCError.Create('too many primary pages'); + For i := 0 To _pages - 2 Do + Begin + LOG('creating primary page surface'); + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + descriptor.dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT; + descriptor.dwWidth := m_width; + descriptor.dwHeight := m_height; + descriptor.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN; + If video Then + descriptor.ddsCaps.dwCaps := descriptor.ddsCaps.dwCaps Or DDSCAPS_VIDEOMEMORY; + DirectXCheck(m_lpDD2^.lpVtbl^.CreateSurface(m_lpDD2, @descriptor, @m_lpDDS_primary_page[i], Nil), 'm_lpDD2^.CreateSurface failed in TDirectXPrimary.primary (primary page)'); + + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + DirectXCheck(m_lpDDS_primary_page[i]^.lpVtbl^.GetSurfaceDesc(m_lpDDS_primary_page[i], @descriptor), 'm_lpDDS_primary_page^.GetSurfaceDesc failed in TDirectXPrimary.primary'); + + If (descriptor.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY) <> 0 Then + Begin + LOG('primary surface page is in video memory'); + End + Else + Begin + LOG('primary surface page is in system memory'); + End; + LOG('attaching page to primary surface'); + DirectXCheck(m_lpDDS_primary^.lpVtbl^.AddAttachedSurface(m_lpDDS_primary, m_lpDDS_primary_page[i]), 'm_lpDDS_primary^.AddAttachedSurface failed in TDirectXPrimary.primary'); + End; + End; + m_primary_width := m_width; + m_primary_height := m_height; + If Not fullscreen Then + Begin + GetClientRect(m_window.handle, rectangle); + m_width := rectangle.right; + m_height := rectangle.bottom; + End; + FreeAndNil(m_area); + m_area := TPTCArea.Create(0, 0, m_width, m_height); + FreeAndNil(m_clip); + m_clip := TPTCArea.Create(m_area); + If _pages > 1 Then + Begin + capabilities.dwCaps := DDSCAPS_BACKBUFFER; + DirectXCheck(m_front^.lpVtbl^.GetAttachedSurface(m_front, @capabilities, @m_lpDDS_primary_back), 'm_front^.GetAttachedSurface failed in TDirectXPrimary.primary'); + + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + DirectXCheck(m_lpDDS_primary_back^.lpVtbl^.GetSurfaceDesc(m_lpDDS_primary_back, @descriptor), 'm_lpDDS_primary_back^.GetSurfaceDesc failed in TDirectXPrimary.primary'); + + If (descriptor.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY) <> 0 Then + Begin + LOG('primary back surface is in video memory'); + End + Else + Begin + LOG('primary back surface is in system memory'); + End; + End + Else + m_lpDDS_primary_back := m_front; + m_back := m_lpDDS_primary_back; + If fullscreen Then + While _pages > 0 Do + Begin + Dec(_pages); + LOG('clearing primary page'); + clear; + update; + End; + Except + On error : TPTCError Do + Begin + If m_lpDDS_primary <> Nil Then + Begin + m_lpDDS_primary^.lpVtbl^.Release(m_lpDDS_primary); + m_lpDDS_primary := Nil; + End; + Raise TPTCError.Create('could not create primary surface', error); + End; + End; +End; + +Procedure TDirectXPrimary.secondary(_width, _height : Integer); + +Var + descriptor : DDSURFACEDESC; + hel : DDCAPS; + driver : DDCAPS; + capabilities : DDSCAPS; + +Begin + LOG('creating secondary surface'); + LOG('width', _width); + LOG('height', _height); + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + descriptor.dwFlags := DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH; + descriptor.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN; + descriptor.dwHeight := _height; + descriptor.dwWidth := _width; + DirectXCheck(m_lpDD2^.lpVtbl^.CreateSurface(m_lpDD2, @descriptor, @m_lpDDS_secondary, Nil), 'm_lpDD2^.CreateSurface failed in TDirectXPrimary.secondary'); + + FillChar(descriptor, SizeOf(descriptor), 0); + descriptor.dwSize := SizeOf(descriptor); + DirectXCheck(m_lpDDS_secondary^.lpVtbl^.GetSurfaceDesc(m_lpDDS_secondary, @descriptor), 'm_lpDDS_secondary^.GetSurfaceDesc failed in TDirectXPrimary.secondary'); + + If (descriptor.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY) <> 0 Then + Begin + LOG('secondary surface is in video memory'); + End + Else + Begin + LOG('secondary surface is in system memory'); + End; + + If Not m_fullscreen Then + Begin + LOG('attaching clipper to primary surface'); + DirectXCheck(m_lpDD2^.lpVtbl^.CreateClipper(m_lpDD2, 0, @m_lpDDC, Nil), 'm_lpDD2^.CreateClipper failed in TDirectXPrimary.secondary'); + DirectXCheck(m_lpDDC^.lpVtbl^.SetHWnd(m_lpDDC, 0, m_window.handle), 'm_lpDDC^.SetHWnd failed in TDirectXPrimary.secondary'); + DirectXCheck(m_lpDDS_primary^.lpVtbl^.SetClipper(m_lpDDS_primary, m_lpDDC), 'm_lpDDS_primary^.SetClipper failed in TDirectXPrimary.secondary'); + End; + m_width := _width; + m_height := _height; + FreeAndNil(m_area); + m_area := TPTCArea.Create(0, 0, m_width, m_height); + FreeAndNil(m_clip); + m_clip := TPTCArea.Create(m_area); + m_secondary_width := m_width; + m_secondary_height := m_height; + m_back := m_lpDDS_secondary; + +{ hel.dwSize := SizeOf(hel); + driver.dwSize := SizeOf(driver); + DirectXCheck(m_lpDD2^.GetCaps(@driver, @hel));} + { + auto stretching support is disabled below because in almost 100% of cases + centering is faster and we must choose the fastest option by default! + } + {todo: DDCAPS!!!!!!!!!!!} +{ If ((driver.dwCaps And DDCAPS_BLTSTRETCH) <> 0) And + ((driver.dwFXCaps And DDFXCAPS_BLTSTRETCHY) <> 0) Then + Begin + LOG('found hardware stretching support'); + End + Else + Begin + LOG('no hardware stretching support'); + End;} + + m_lpDDS_secondary^.lpVtbl^.GetCaps(m_lpDDS_secondary, @capabilities); + If (capabilities.dwCaps And DDSCAPS_SYSTEMMEMORY) <> 0 Then + Begin + LOG('secondary surface is in system memory'); + End; + + centering(True); + + LOG('clearing secondary page'); + + clear; + + update; +End; + +Procedure TDirectXPrimary.synchronize(_update : Boolean); + +Begin + m_synchronize := _update; + If m_pages > 1 Then + m_synchronize := False; + LOG('primary synchronize', _update); +End; + +Procedure TDirectXPrimary.centering(center : Boolean); + +Begin + m_centering := center; + LOG('primary centering', m_centering); +End; + +Procedure TDirectXPrimary.close; + +Var + i : Integer; + lost : Boolean; + tmp : TPTCPalette; + +Begin + Try + LOG('closing primary surface'); + lost := False; + If (m_lpDDS_primary <> Nil) And (m_lpDDS_primary^.lpVtbl^.IsLost(m_lpDDS_primary) <> DD_OK) Then + lost := True; + If (m_lpDDS_secondary <> Nil) And (m_lpDDS_secondary^.lpVtbl^.IsLost(m_lpDDS_secondary) <> DD_OK) Then + lost := True; + If (m_back <> Nil) And (m_lpDDS_primary <> Nil) And m_fullscreen And (Not lost) Then + Begin + tmp := TPTCPalette.Create; + Try + LOG('clearing primary palette'); + palette(tmp); + Finally + tmp.Free; + End; + LOG('clearing primary pages'); + For i := 0 To m_pages - 1 Do + Begin + clear; + update; + End; + End; + Except + On TPTCError Do + Begin + LOG('primary close clearing failed'); + End; + End; + + If m_lpDDC <> Nil Then + Begin + LOG('releasing clipper'); + m_lpDDC^.lpVtbl^.Release(m_lpDDC); + m_lpDDC := Nil; + End; + If m_lpDDS_secondary <> Nil Then + Begin + LOG('releasing secondary surface'); + m_lpDDS_secondary^.lpVtbl^.Release(m_lpDDS_secondary); + m_lpDDS_secondary := Nil; + End; + i := 0; + While m_lpDDS_primary_page[i] <> Nil Do + Begin + LOG('releasing attached primary surface page'); + m_lpDDS_primary_page[i]^.lpVtbl^.Release(m_lpDDS_primary_page[i]); + m_lpDDS_primary_page[i] := Nil; + Inc(i); + End; + If m_lpDDS_primary <> Nil Then + Begin + LOG('releasing primary surface'); + m_lpDDS_primary^.lpVtbl^.Release(m_lpDDS_primary); + m_lpDDS_primary := Nil; + End; + + m_back := Nil; + m_front := Nil; + m_lpDDS_primary_back := Nil; +End; + +Procedure TDirectXPrimary.update; + +Begin + block; + paint; + If m_pages > 1 Then + DirectXCheck(m_front^.lpVtbl^.Flip(m_front, Nil, DDFLIP_WAIT), 'm_front^.Flip failed in TDirectXPrimary.update'); +End; + +Function TDirectXPrimary.lock : Pointer; + +Var + descriptor : DDSURFACEDESC; + pnt : POINT; + rct : RECT; + +Begin + block; + descriptor.dwSize := SizeOf(descriptor); + If m_fullscreen Or (m_back = m_lpDDS_secondary) Then + Begin + DirectXCheck(m_back^.lpVtbl^.Lock(m_back, Nil, @descriptor, DDLOCK_WAIT, 0), 'm_back^.Lock failed in TDirectXPrimary.lock'); + m_locked := descriptor.lpSurface; + End + Else + Begin + pnt.x := 0; + pnt.y := 0; + ClientToScreen(m_window.handle, pnt); + rct.left := pnt.x; + rct.top := pnt.y; + rct.right := pnt.x + m_width; + rct.bottom := pnt.y + m_height; + DirectXCheck(m_back^.lpVtbl^.Lock(m_back, @rct, @descriptor, DDLOCK_WAIT, 0), 'm_back^.Lock(rect) failed in TDirectXPrimary.lock'); + m_locked := descriptor.lpSurface; + End; + lock := m_locked; +End; + +Procedure TDirectXPrimary.unlock; + +Begin + block; + DirectXCheck(m_back^.lpVtbl^.Unlock(m_back, m_locked), 'm_back^.Unlock failed in TDirectXPrimary.unlock'); +End; + +Procedure TDirectXPrimary.clear; + +Var + fx : DDBLTFX; + tmp : TPTCColor; + +Begin + block; + If m_fullscreen Or (m_back = m_lpDDS_secondary) Then + Begin + fx.dwSize := SizeOf(fx); + fx.dwFillColor := 0; + DirectXCheck(m_back^.lpVtbl^.Blt(m_back, Nil, Nil, Nil, DDBLT_COLORFILL Or DDBLT_WAIT, @fx), 'm_back^.Blt failed in TDirectXPrimary.clear'); + End + Else + Begin + { todo: replace with hardware clear! } + If format.direct Then + Begin + tmp := TPTCColor.Create(0, 0, 0, 0); + Try + clear(tmp, m_area); + Finally + tmp.Free; + End; + End + Else + Begin + tmp := TPTCColor.Create(0); + Try + clear(tmp, m_area); + Finally + tmp.Free; + End; + End; + End; +End; + +Procedure TDirectXPrimary.clear(Const color : TPTCColor; Const _area : TPTCArea); + +Var + clipped, clipped_area : TPTCArea; + clear_color : DWord; + rct : RECT; + fx : DDBLTFX; + pixels : Pointer; + + +Begin + block; + If m_fullscreen Or (m_back = m_lpDDS_secondary) Then + Begin + clipped := TPTCClipper.clip(_area, m_clip); + Try + clear_color := pack(color, m_format); + With rct Do + Begin + left := clipped.left; + top := clipped.top; + right := clipped.right; + bottom := clipped.bottom; + End; + fx.dwSize := SizeOf(fx); + fx.dwFillColor := clear_color; + DirectXCheck(m_back^.lpVtbl^.Blt(m_back, @rct, Nil, Nil, DDBLT_COLORFILL Or DDBLT_WAIT, @fx), 'm_back^.Blt(rect) failed in TDirectXPrimary.clear'); + Finally + clipped.Free; + End; + End + Else + Begin + { todo: replace with accelerated clearing code! } + pixels := lock; + clipped_area := Nil; + Try + Try + clipped_area := TPTCClipper.clip(_area, clip); + m_clear.request(format); + m_clear.clear(pixels, clipped_area.left, clipped_area.right, clipped_area.width, clipped_area.height, pitch, color); + unlock; + Except + On error : TPTCError Do + Begin + unlock; + Raise TPTCError.Create('failed to clear console area', error); + End; + End; + Finally + If clipped_area <> Nil Then + clipped_area.Free; + End; + End; +End; + +Procedure TDirectXPrimary.palette(Const _palette : TPTCPalette); + +Var + data : Pint32; + temp : Array[0..255] Of PALETTEENTRY; + i : Integer; + lpDDP : LPDIRECTDRAWPALETTE; + +Begin + block; + + m_palette.load(_palette.data); + If Not m_format.indexed Then + Begin + LOG('palette set in direct color'); + End + Else + Begin + data := _palette.data; + For i := 0 To 255 Do + Begin + temp[i].peRed := (data[i] And $00FF0000) Shr 16; + temp[i].peGreen := (data[i] And $0000FF00) Shr 8; + temp[i].peBlue := data[i] And $000000FF; + temp[i].peFlags := 0; + End; + lpDDP := Nil; + If m_lpDDS_primary^.lpVtbl^.GetPalette(m_lpDDS_primary, @lpDDP) <> DD_OK Then + Begin + DirectXCheck(m_lpDD2^.lpVtbl^.CreatePalette(m_lpDD2, DDPCAPS_8BIT Or DDPCAPS_ALLOW256 Or DDPCAPS_INITIALIZE, @temp, @lpDDP, Nil), 'm_lpDD2^.CreatePalette failed in TDirectXPrimary.palette'); + DirectXCheck(m_lpDDS_primary^.lpVtbl^.SetPalette(m_lpDDS_primary, lpDDP), 'm_lpDDS_primary^.SetPalette failed in TDirectXPrimary.palette'); + End + Else + DirectXCheck(lpDDP^.lpVtbl^.SetEntries(lpDDP, 0, 0, 256, @temp), 'lpDDP^.SetEntries failed in TDirectXPrimary.palette'); + End; +End; + +Function TDirectXPrimary.palette : TPTCPalette; + +Begin + palette := m_palette; +End; + +Procedure TDirectXPrimary.clip(Const _area : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + tmp := TPTCClipper.clip(_area, m_area); + Try + m_clip.ASSign(tmp); + Finally + tmp.Free; + End; +End; + +Function TDirectXPrimary.width : Integer; + +Begin + width := m_width; +End; + +Function TDirectXPrimary.height : Integer; + +Begin + height := m_height; +End; + +Function TDirectXPrimary.pages : Integer; + +Begin + pages := m_pages; +End; + +Function TDirectXPrimary.pitch : Integer; + +Var + descriptor : DDSURFACEDESC; + +Begin + Block; + descriptor.dwSize := SizeOf(descriptor); + DirectXCheck(m_back^.lpVtbl^.GetSurfaceDesc(m_back, @descriptor), 'm_back^.GetSurfaceDesc failed in TDirectXPrimary.pitch'); + pitch := descriptor.lPitch; +End; + +Function TDirectXPrimary.area : TPTCArea; + +Begin + area := m_area; +End; + +Function TDirectXPrimary.clip : TPTCArea; + +Begin + clip := m_clip; +End; + +Function TDirectXPrimary.format : TPTCFormat; + +Begin + format := m_format; +End; + +Function TDirectXPrimary.lpDDS : LPDIRECTDRAWSURFACE; + +Begin + If m_lpDDS_secondary <> Nil Then + lpDDS := m_lpDDS_secondary + Else + lpDDS := m_lpDDS_primary_back; +End; + +Function TDirectXPrimary.lpDDS_primary : LPDIRECTDRAWSURFACE; + +Begin + lpDDS_primary := m_lpDDS_primary; +End; + +Function TDirectXPrimary.lpDDS_secondary : LPDIRECTDRAWSURFACE; + +Begin + lpDDS_secondary := m_lpDDS_secondary; +End; + +Procedure TDirectXPrimary.activate; + +Begin + LOG('primary activated'); + m_active := True; +End; + +Procedure TDirectXPrimary.deactivate; + +Begin + LOG('primary deactivated'); + If m_blocking Then + m_active := False + Else + {no deactivation when not blocking}; +End; + +Function TDirectXPrimary.active : Boolean; + +Begin + active := m_active; +End; + +Procedure TDirectXPrimary.block; + +Var + restored : Boolean; + +Begin + If Not m_blocking Then + Exit; + If Not active Then + Begin + restored := False; + While Not restored Do + Begin + LOG('blocking until activated'); + While Not active Do + Begin + m_window.update(True); + Sleep(10); + End; + LOG('primary is active'); + m_window.update(True); + Try + restore; + restored := True; + LOG('successful restore'); + Except + On TPTCError Do + Begin + LOG('application is active but cannot restore'); + End; + End; + Sleep(10); + End; + End; + If m_lpDDS_primary^.lpVtbl^.IsLost(m_lpDDS_primary) <> DD_OK Then + Raise TPTCError.Create('primary surface lost unexpectedly!'); + If (m_lpDDS_secondary <> Nil) And (m_lpDDS_secondary^.lpVtbl^.IsLost(m_lpDDS_secondary) <> DD_OK) Then + Raise TPTCError.Create('secondary surface lost unexpectedly!'); +End; + +Procedure TDirectXPrimary.save; + +Begin + If m_lpDDS_primary^.lpVtbl^.IsLost(m_lpDDS_primary) = DD_OK Then + Begin + LOG('saving contents of primary surface'); + + { todo: save contents of primary surface } + End + Else + Begin + LOG('could not save primary surface'); + End; + + If (m_lpDDS_secondary <> Nil) And (m_lpDDS_secondary^.lpVtbl^.IsLost(m_lpDDS_secondary) = DD_OK) Then + Begin + LOG('saving contents of secondary surface'); + + { todo: save contents of secondary surface } + End + Else + If m_lpDDS_secondary <> Nil Then + Begin + LOG('could not save secondary surface'); + End; +End; + +Procedure TDirectXPrimary.restore; + +Var + i : Integer; + rct : RECT; + fx : DDBLTFX; + +Begin + DirectXCheck(m_lpDDS_primary^.lpVtbl^.Restore(m_lpDDS_primary), 'm_lpDDS_primary^.Restore failed in TDirectXConsole.restore'); + If m_lpDDS_secondary <> Nil Then + DirectXCheck(m_lpDDS_secondary^.lpVtbl^.Restore(m_lpDDS_secondary), 'm_lpDDS_secondary^.Restore failed in TDirectXConsole.restore'); + LOG('restoring contents of primary surface'); + { todo: restore palette object on primary surface ? } + { todo: restore contents of primary surface } + If m_lpDDS_primary_page[0] <> Nil Then + Begin + LOG('restoring attached pages'); + For i := 0 To m_pages - 2 Do + DirectXCheck(m_lpDDS_primary_page[i]^.lpVtbl^.Restore(m_lpDDS_primary_page[i]), 'm_lpDDS_primary_page^.Restore failed in TDirectXConsole.restore'); + End; + + If m_lpDDS_secondary <> Nil Then + Begin + If m_fullscreen Then + Begin + LOG('temporary primary surface clear'); + + { temporary: clear primary surface } + With rct Do + Begin + left := 0; + top := 0; + right := m_primary_width; + bottom := m_primary_height; + End; + fx.dwSize := SizeOf(fx); + fx.dwFillColor := 0; + DirectXCheck(m_lpDDS_primary^.lpVtbl^.Blt(m_lpDDS_primary, @rct, Nil, Nil, DDBLT_COLORFILL Or DDBLT_WAIT, @fx), 'm_lpDDS_primary^.Blt failed in TDirectXPrimary.restore'); + End; + LOG('restoring contents of secondary surface'); + { todo: restore contents of secondary surface } + End; +End; + +Procedure TDirectXPrimary.paint; + +Var + source, destination : RECT; + pnt : POINT; + x, y : Integer; + fx : DDBLTFX; + +Begin + If Not active Then + Begin + LOG('paint when not active'); + Exit; + End; + If m_lpDDS_secondary <> Nil Then + Begin + If (m_lpDDS_primary^.lpVtbl^.IsLost(m_lpDDS_primary) <> DD_OK) Or + (m_lpDDS_secondary^.lpVtbl^.IsLost(m_lpDDS_secondary) <> DD_OK) Then + Begin + LOG('paint when surfaces are lost'); + Exit; + End; + source.left := 0; + source.top := 0; + source.right := m_secondary_width; + source.bottom := m_secondary_height; + destination.left := 0; + destination.top := 0; + destination.right := m_primary_width; + destination.bottom := m_primary_height; + + { note: code below assumes secondary is smaller than primary } + If m_centering And m_fullscreen Then + Begin + x := (destination.right - source.right) Div 2; + y := (destination.bottom - source.bottom) Div 2; + + destination.left := x; + destination.top := y; + destination.right := x + source.right; + destination.bottom := y + source.bottom; + End; + If Not m_fullscreen Then + Begin + pnt.x := 0; + pnt.y := 0; + ClientToScreen(m_window.handle, pnt); + + GetClientRect(m_window.handle, destination); + Inc(destination.left, pnt.x); + Inc(destination.top, pnt.y); + Inc(destination.right, pnt.x); + Inc(destination.bottom, pnt.y); + End; + + If ((source.right - source.left) = 0) Or + ((source.bottom - source.top) = 0) Or + ((destination.right - destination.left) = 0) Or + ((destination.bottom - destination.top) = 0) Then + Begin + LOG('zero area in primary paint'); + Exit; + End; + + If m_synchronize Then + Begin + fx.dwSize := SizeOf(fx); + fx.dwDDFX := DDBLTFX_NOTEARING; + Try + DirectXCheck(m_lpDDS_primary_back^.lpVtbl^.Blt(m_lpDDS_primary_back, @destination, m_lpDDS_secondary, @source, DDBLT_WAIT Or DDBLT_DDFX, @fx), 'm_lpDDS_primary^.Blt (synchronized) failed in TDirectXPrimary.paint'); + Except + On TPTCError Do + Begin + LOG('falling back to unsynchronized blt'); + m_synchronize := False; + End; + End; + End; + If Not m_synchronize Then + DirectXCheck(m_lpDDS_primary_back^.lpVtbl^.Blt(m_lpDDS_primary_back, @destination, m_lpDDS_secondary, @source, DDBLT_WAIT, Nil), 'm_lpDDS_primary^.Blt (unsynchronized) failed in TDirectXPrimary.paint'); + End; +End; + +Procedure TDirectXPrimary.blocking(_blocking : Boolean); + +Begin + m_blocking := _blocking; +End; + +Function TDirectXPrimary.pack(Const color : TPTCColor; Const _format : TPTCFormat) : int32; + +Var + r_base, g_base, b_base, a_base : Integer; + r_size, g_size, b_size, a_size : Integer; + r_scale, g_scale, b_scale, a_scale : Single; + +Begin + If color.direct And _format.direct Then + Begin + r_base := 0; + g_base := 0; + b_base := 0; + a_base := 0; + r_size := 0; + g_size := 0; + b_size := 0; + a_size := 0; + analyse(_format.r, r_base, r_size); + analyse(_format.g, g_base, g_size); + analyse(_format.b, b_base, b_size); + analyse(_format.a, a_base, a_size); + r_scale := 1 Shl r_size; + g_scale := 1 Shl g_size; + b_scale := 1 Shl b_size; + a_scale := 1 Shl a_size; + pack := (Trunc(color.r * r_scale) Shl r_base) Or + (Trunc(color.g * g_scale) Shl g_base) Or + (Trunc(color.b * b_scale) Shl b_base) Or + (Trunc(color.a * a_scale) Shl a_base); + End + Else + If color.indexed And _format.indexed Then + pack := color.index + Else + Raise TPTCError.Create('color format type mismatch'); +End; + +Procedure TDirectXPrimary.analyse(mask : int32; Var base, size : Integer); + +Begin + base := 0; + size := 0; + If mask = 0 Then + Exit; + While (mask And 1) = 0 Do + Begin + mask := mask Shr 1; + Inc(base); + End; + While (mask And 1) <> 0 Do + Begin + mask := mask Shr 1; + Inc(size); + End; +End; diff --git a/packages/ptc/src/win32/directx/primaryd.inc b/packages/ptc/src/win32/directx/primaryd.inc new file mode 100644 index 0000000000..d528eb05d6 --- /dev/null +++ b/packages/ptc/src/win32/directx/primaryd.inc @@ -0,0 +1,112 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TDirectXPrimary = Class(TObject) + Private + Function pack(Const color : TPTCColor; Const _format : TPTCFormat) : int32; + Procedure analyse(mask : int32; Var base, size : Integer); + + m_width : Integer; + m_height : Integer; + m_pages : Integer; + m_area : TPTCArea; + m_clip : TPTCArea; + m_format : TPTCFormat; + + m_active : Boolean; + m_blocking : Boolean; + m_centering : Boolean; + m_fullscreen : Boolean; + m_synchronize : Boolean; + + m_clear : TPTCClear; + + m_window : TWin32Window; + + m_locked : Pointer; + + m_palette : TPTCPalette; + + m_primary_width : Integer; + m_primary_height : Integer; + + m_secondary_width : Integer; + m_secondary_height : Integer; + + m_lpDD2 : LPDIRECTDRAW2; + + m_lpDDS : LPDIRECTDRAWSURFACE; + m_lpDDS_primary : LPDIRECTDRAWSURFACE; + m_lpDDS_primary_back : LPDIRECTDRAWSURFACE; + m_lpDDS_primary_page : Array[0..31] Of LPDIRECTDRAWSURFACE; + + m_lpDDS_secondary : LPDIRECTDRAWSURFACE; + + m_lpDDC : LPDIRECTDRAWCLIPPER; + + m_back, m_front : LPDIRECTDRAWSURFACE; + Public + Constructor Create; + Destructor Destroy; Override; + + Procedure initialize(Window : TWin32Window; lpDD2 : LPDIRECTDRAW2); + Procedure primary(_pages : Integer; video, fullscreen, _palette, complex : Boolean); + Procedure secondary(_width, _height : Integer); + Procedure synchronize(_update : Boolean); + Procedure centering(center : Boolean); + Procedure close; + + Procedure update; + + Function lock : Pointer; + Procedure unlock; + + Procedure clear; + Procedure clear(Const color : TPTCColor; Const _area : TPTCArea); + + Procedure palette(Const _palette : TPTCPalette); + Function palette : TPTCPalette; + + Procedure clip(Const _area : TPTCArea); + + Function width : Integer; + Function height : Integer; + Function pages : Integer; + Function pitch : Integer; + Function area : TPTCArea; + Function clip : TPTCArea; + Function format : TPTCFormat; + + Function lpDDS : LPDIRECTDRAWSURFACE; + Function lpDDS_primary : LPDIRECTDRAWSURFACE; + Function lpDDS_secondary : LPDIRECTDRAWSURFACE; + + Procedure activate; + Procedure deactivate; + Function active : Boolean; + Procedure block; + Procedure save; + Procedure restore; + + Procedure paint; + + Procedure blocking(_blocking : Boolean); + End; diff --git a/packages/ptc/src/win32/directx/translate.inc b/packages/ptc/src/win32/directx/translate.inc new file mode 100644 index 0000000000..7981ddf1e7 --- /dev/null +++ b/packages/ptc/src/win32/directx/translate.inc @@ -0,0 +1,32 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Function DirectXTranslate(Const ddpf : DDPIXELFORMAT) : TPTCFormat; + +Begin + If (ddpf.dwFlags And DDPF_PALETTEINDEXED8) <> 0 Then + Exit(TPTCFormat.Create(8)) + Else + If (ddpf.dwFlags And DDPF_RGB) <> 0 Then + With ddpf Do + Exit(TPTCFormat.Create(dwRGBBitCount, dwRBitMask, dwGBitMask, dwBBitMask)) + Else + Raise TPTCError.Create('invalid pixel format'); +End; diff --git a/packages/ptc/src/win32/gdi/gdiconsoled.inc b/packages/ptc/src/win32/gdi/gdiconsoled.inc new file mode 100644 index 0000000000..26f6e25eb1 --- /dev/null +++ b/packages/ptc/src/win32/gdi/gdiconsoled.inc @@ -0,0 +1,117 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TGDIConsole = Class(TPTCBaseConsole) + Private + FWindow : TWin32Window; + FWin32DIB : TWin32DIB; + FKeyboard : TWin32Keyboard; + FMouse : TWin32Mouse; + + FCopy : TPTCCopy; + FClear : TPTCClear; + FEventQueue : TEventQueue; + FArea : TPTCArea; + FClip : TPTCArea; + FPalette : TPTCPalette; + + FOpen : Boolean; + FLocked : Boolean; + + FTitle : String; + + FDefaultWidth : Integer; + FDefaultHeight : Integer; + FDefaultFormat : TPTCFormat; + + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetPages : Integer; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + + Procedure CheckOpen( AMessage : String); + Procedure CheckUnlocked(AMessage : String); + Public + Constructor Create; Override; + Destructor Destroy; Override; + + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Override; + Procedure Close; Override; + + Procedure Copy(Var ASurface : TPTCBaseSurface); Override; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Override; + + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + + Function Lock : Pointer; Override; + Procedure Unlock; Override; + + Procedure Clear; Override; + Procedure Clear(Const AColor : TPTCColor); Override; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Override; + + Procedure Configure(Const AFileName : String); Override; + Function Option(Const AOption : String) : Boolean; Override; + + Procedure Palette(Const APalette : TPTCPalette); Override; + Procedure Clip(Const AArea : TPTCArea); Override; + Function Clip : TPTCArea; Override; + Function Palette : TPTCPalette; Override; + Function Modes : PPTCMode; Override; + + Procedure Flush; Override; + Procedure Finish; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/win32/gdi/gdiconsolei.inc b/packages/ptc/src/win32/gdi/gdiconsolei.inc new file mode 100644 index 0000000000..899e06b855 --- /dev/null +++ b/packages/ptc/src/win32/gdi/gdiconsolei.inc @@ -0,0 +1,538 @@ +Constructor TGDIConsole.Create; + +Begin + Inherited Create; + + FDefaultWidth := 320; + FDefaultHeight := 200; + FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + FCopy := TPTCCopy.Create; + FClear := TPTCClear.Create; + FArea := TPTCArea.Create; + FClip := TPTCArea.Create; + FPalette := TPTCPalette.Create; + + FOpen := False; + + { configure console } + Configure('ptcpas.cfg'); +End; + +Destructor TGDIConsole.Destroy; + +Begin + Close; + + {...} + + FWin32DIB.Free; + FWindow.Free; + FPalette.Free; + FEventQueue.Free; + FCopy.Free; + FClear.Free; + FArea.Free; + FClip.Free; + FDefaultFormat.Free; + + Inherited Destroy; +End; + +Procedure TGDIConsole.Open(Const ATitle : String; APages : Integer = 0); + +Begin + Open(ATitle, FDefaultFormat, APages); +End; + +Procedure TGDIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); + +Begin + Open(ATitle, FDefaultWidth, FDefaultHeight, AFormat, APages); +End; + +Procedure TGDIConsole.Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); + +Begin + Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages); +End; + +Procedure TGDIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); + +Var + tmp : TPTCArea; + +Begin + If FOpen Then + Close; + +(* FWindow := TWin32Window.Create('PTC_GDI_FULLSCREEN', + ATitle, + WS_EX_TOPMOST, + DWord(WS_POPUP Or WS_SYSMENU Or WS_VISIBLE), // fpc windows RTL bug - WS_POPUP should be a DWord!!! + SW_NORMAL, + 0, 0, + GetSystemMetrics(SM_CXSCREEN), + GetSystemMetrics(SM_CYSCREEN), + False, False);*) + + FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_FIXED', + ATitle, + 0, + WS_VISIBLE Or WS_SYSMENU Or WS_CAPTION Or WS_MINIMIZEBOX, + SW_NORMAL, + CW_USEDEFAULT, CW_USEDEFAULT, + AWidth, AHeight, + {m_center_window}False, + False); + +(* FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_RESIZABLE', + ATitle, + 0, + WS_OVERLAPPEDWINDOW Or WS_VISIBLE, + SW_NORMAL, + CW_USEDEFAULT, CW_USEDEFAULT, + AWidth, AHeight, + {m_center_window}False, + False);*) + + FWin32DIB := TWin32DIB.Create(AWidth, AHeight); + + FreeAndNil(FKeyboard); + FreeAndNil(FMouse); + FreeAndNil(FEventQueue); + FEventQueue := TEventQueue.Create; + FKeyboard := TWin32Keyboard.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue); + FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, {FFullScreen}False, AWidth, AHeight); + + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + FArea.Assign(tmp); + FClip.Assign(tmp); + Finally + tmp.Free; + End; + + FWindow.Update; + + FTitle := ATitle; + + FOpen := True; +End; + +Procedure TGDIConsole.Close; + +Begin + If Not FOpen Then + Exit; + + {...} + + FreeAndNil(FKeyboard); + FreeAndNil(FMouse); + + FreeAndNil(FWin32DIB); + FreeAndNil(FWindow); + + FreeAndNil(FEventQueue); + + FTitle := ''; + + FOpen := False; +End; + +Procedure TGDIConsole.Copy(Var ASurface : TPTCBaseSurface); + +Begin + // todo... +End; + +Procedure TGDIConsole.Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); + +Begin + // todo... +End; + +Procedure TGDIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + CheckOpen( 'TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + CheckUnlocked('TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + If Clip.Equals(Area) Then + Begin + Try + console_pixels := Lock; + Try + FCopy.Request(AFormat, Format); + FCopy.Palette(APalette, Palette); + FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0, + Width, Height, Pitch); + Finally + Unlock; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TGDIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + CheckOpen( 'TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + CheckUnlocked('TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + clipped_source := Nil; + clipped_destination := Nil; + Try + console_pixels := Lock; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination); + Finally + tmp.Free; + End; + FCopy.request(AFormat, Format); + FCopy.palette(APalette, Palette); + FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch); + Finally + Unlock; + clipped_source.Free; + clipped_destination.Free; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console area', error); + End; +End; + +Procedure TGDIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + // todo... +End; + +Procedure TGDIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + // todo... +End; + +Function TGDIConsole.Lock : Pointer; + +Begin + Result := FWin32DIB.Pixels; // todo... + FLocked := True; +End; + +Procedure TGDIConsole.Unlock; + +Begin + FLocked := False; +End; + +Procedure TGDIConsole.Clear; + +Begin + // todo... +End; + +Procedure TGDIConsole.Clear(Const AColor : TPTCColor); + +Begin + // todo... +End; + +Procedure TGDIConsole.Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); + +Begin + // todo... +End; + +Procedure TGDIConsole.Configure(Const AFileName : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, AFileName); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + Option(S); + End; + CloseFile(F); +End; + +Function TGDIConsole.Option(Const AOption : String) : Boolean; + +Begin + // todo... + + Result := FCopy.Option(AOption); +End; + +Procedure TGDIConsole.Palette(Const APalette : TPTCPalette); + +Begin + // todo... +End; + +Procedure TGDIConsole.Clip(Const AArea : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + CheckOpen('TGDIConsole.Clip(AArea)'); + + tmp := TPTCClipper.Clip(AArea, FArea); + Try + FClip.Assign(tmp); + Finally + tmp.Free; + End; +End; + +Function TGDIConsole.Clip : TPTCArea; + +Begin + CheckOpen('TGDIConsole.Clip'); + Result := FClip; +End; + +Function TGDIConsole.Palette : TPTCPalette; + +Begin + CheckOpen('TGDIConsole.Palette'); + Result := FPalette; +End; + +Function TGDIConsole.Modes : PPTCMode; + +Begin + // todo... + Result := Nil; +End; + +Procedure TGDIConsole.Flush; + +Begin + CheckOpen( 'TGDIConsole.Flush'); + CheckUnlocked('TGDIConsole.Flush'); + + // todo... +End; + +Procedure TGDIConsole.Finish; + +Begin + CheckOpen( 'TGDIConsole.Finish'); + CheckUnlocked('TGDIConsole.Finish'); + + // todo... +End; + +Procedure TGDIConsole.Update; + +Var + ClientRect : RECT; + DeviceContext : HDC; + +Begin + CheckOpen( 'TGDIConsole.Update'); + CheckUnlocked('TGDIConsole.Update'); + + FWindow.Update; + + DeviceContext := GetDC(FWindow.m_window); + + If DeviceContext <> 0 Then + Begin + If GetClientRect(FWindow.m_window, @ClientRect) Then + Begin + StretchDIBits(DeviceContext, + 0, 0, ClientRect.right, ClientRect.bottom, + 0, 0, FWin32DIB.Width, FWin32DIB.Height, + FWin32DIB.Pixels, + FWin32DIB.BMI^, + DIB_RGB_COLORS, + SRCCOPY); + End; + + ReleaseDC(FWindow.m_window, DeviceContext); + End; +End; + +Procedure TGDIConsole.Update(Const AArea : TPTCArea); + +Begin + Update; +End; + +Function TGDIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Begin + CheckOpen('TGDIConsole.NextEvent'); +// CheckUnlocked('TGDIConsole.NextEvent'); + + FreeAndNil(AEvent); + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + AEvent := FEventQueue.NextEvent(AEventMask); + Until (Not AWait) Or (AEvent <> Nil); + Result := AEvent <> Nil; +End; + +Function TGDIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Begin + CheckOpen('TGDIConsole.PeekEvent'); +// CheckUnlocked('TGDIConsole.PeekEvent'); + + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(AEventMask); + Until (Not AWait) Or (Result <> Nil); +End; + +Function TGDIConsole.GetWidth : Integer; + +Begin + CheckOpen('TGDIConsole.GetWidth'); + Result := FWin32DIB.Width; +End; + +Function TGDIConsole.GetHeight : Integer; + +Begin + CheckOpen('TGDIConsole.GetHeight'); + Result := FWin32DIB.Height; +End; + +Function TGDIConsole.GetPitch : Integer; + +Begin + CheckOpen('TGDIConsole.GetPitch'); + Result := FWin32DIB.Pitch; +End; + +Function TGDIConsole.GetArea : TPTCArea; + +Begin + CheckOpen('TGDIConsole.GetArea'); + Result := FArea; +End; + +Function TGDIConsole.GetFormat : TPTCFormat; + +Begin + CheckOpen('TGDIConsole.GetFormat'); + Result := FWin32DIB.Format; +End; + +Function TGDIConsole.GetPages : Integer; + +Begin + CheckOpen('TGDIConsole.GetPages'); + Result := 2; +End; + +Function TGDIConsole.GetName : String; + +Begin + Result := 'GDI'; +End; + +Function TGDIConsole.GetTitle : String; + +Begin + CheckOpen('TGDIConsole.GetTitle'); + Result := FTitle; +End; + +Function TGDIConsole.GetInformation : String; + +Begin + CheckOpen('TGDIConsole.GetInformation'); + Result := ''; // todo... +End; + +Procedure TGDIConsole.CheckOpen(AMessage : String); + +Begin + If Not FOpen Then + Try + Raise TPTCError.Create('console is not open'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; + +Procedure TGDIConsole.CheckUnlocked(AMessage : String); + +Begin + If FLocked Then + Try + Raise TPTCError.Create('console is locked'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; diff --git a/packages/ptc/src/win32/gdi/win32dibd.inc b/packages/ptc/src/win32/gdi/win32dibd.inc new file mode 100644 index 0000000000..2d57a9095e --- /dev/null +++ b/packages/ptc/src/win32/gdi/win32dibd.inc @@ -0,0 +1,17 @@ +Type + TWin32DIB = Class(TObject) + Private + FBitmapInfo : PBITMAPINFO; + FPixels : Pointer; + FFormat : TPTCFormat; + FWidth, FHeight, FPitch : Integer; + Public + Constructor Create(AWidth, AHeight : Integer); + Destructor Destroy; Override; + Property BMI : PBITMAPINFO Read FBitmapInfo; + Property Width : Integer Read FWidth; + Property Height : Integer Read FHeight; + Property Pitch : Integer Read FPitch; + Property Format : TPTCFormat Read FFormat; + Property Pixels : Pointer Read FPixels; + End; diff --git a/packages/ptc/src/win32/gdi/win32dibi.inc b/packages/ptc/src/win32/gdi/win32dibi.inc new file mode 100644 index 0000000000..34b535b7b9 --- /dev/null +++ b/packages/ptc/src/win32/gdi/win32dibi.inc @@ -0,0 +1,45 @@ + +{TODO: create DIBs with the same color depth as the desktop} + +Constructor TWin32DIB.Create(AWidth, AHeight : Integer); + +Begin + FBitmapInfo := GetMem(SizeOf(BITMAPINFOHEADER) + 12); + + FillChar(FBitmapInfo^.bmiHeader, SizeOf(BITMAPINFOHEADER), 0); + With FBitmapInfo^.bmiHeader Do + Begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := AWidth; + biHeight := -AHeight; + biPlanes := 1; + biBitCount := 32; + biCompression := BI_BITFIELDS; + biSizeImage := 0; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + End; + + PDWord(@FBitmapInfo^.bmiColors)[0] := $FF0000; + PDWord(@FBitmapInfo^.bmiColors)[1] := $00FF00; + PDWord(@FBitmapInfo^.bmiColors)[2] := $0000FF; + + FWidth := AWidth; + FHeight := AHeight; + FFormat := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + FPitch := FWidth * 4; + + FPixels := GetMem(AWidth * AHeight * 4); + FillChar(FPixels^, AWidth * AHeight * 4, 0); +End; + +Destructor TWin32DIB.Destroy; + +Begin + FreeMem(FPixels); + FreeMem(FBitmapInfo); + FFormat.Free; + Inherited Destroy; +End; diff --git a/packages/ptc/src/wince/base/wincekeyboardd.inc b/packages/ptc/src/wince/base/wincekeyboardd.inc new file mode 100644 index 0000000000..701acedfaf --- /dev/null +++ b/packages/ptc/src/wince/base/wincekeyboardd.inc @@ -0,0 +1,44 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWinCEKeyboard = Class(TObject) + Private + { data } + FEventQueue : TEventQueue; + + { flag data } + m_enabled : Boolean; + + { modifiers } + m_alt : Boolean; + m_shift : Boolean; + m_control : Boolean; + Public + { setup } + Constructor Create(EventQueue : TEventQueue); + + { window procedure } + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + + { control } + Procedure enable; + Procedure disable; + End; diff --git a/packages/ptc/src/wince/base/wincekeyboardi.inc b/packages/ptc/src/wince/base/wincekeyboardi.inc new file mode 100644 index 0000000000..4a008359ad --- /dev/null +++ b/packages/ptc/src/wince/base/wincekeyboardi.inc @@ -0,0 +1,138 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TWinCEKeyboard.Create(EventQueue : TEventQueue); + +Begin +// m_monitor := Nil; +// m_event := Nil; +// Inherited Create(window, thread); +// m_monitor := TWin32Monitor.Create; +// m_event := TWin32Event.Create; + + { setup defaults } + m_alt := False; + m_shift := False; + m_control := False; + + { setup data } + FEventQueue := EventQueue; +// m_multithreaded := multithreaded; + + { enable buffering } + m_enabled := True; +End; + +Procedure TWinCEKeyboard.enable; + +Begin + { enable buffering } + m_enabled := True; +End; + +Procedure TWinCEKeyboard.disable; + +Begin + { disable buffering } + m_enabled := False; +End; + +Function TWinCEKeyboard.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + +Var + i : Integer; + scancode : Integer; + KeyStateArray : Array[0..255] Of Byte; + AsciiBuf : Word; + press : Boolean; + uni : Integer; + tmp : Integer; + +Begin + WndProc := 0; + { check enabled flag } + If Not m_enabled Then + Exit; + + { process key message } + If (message = WM_KEYDOWN) Or (message = WM_KEYUP) {Or ((message = WM_SYSKEYDOWN) And ((lParam And (1 Shl 29)) <> 0))} Then + Begin + If message = WM_KEYUP Then + press := False + Else + press := True; + + { update modifiers } + If wParam = VK_MENU Then + { alt } + m_alt := press + Else + If wParam = VK_SHIFT Then + { shift } + m_shift := press + Else + If wParam = VK_CONTROL Then + { control } + m_control := press; + + { enter monitor if multithreaded } +(* If m_multithreaded Then + m_monitor.enter;*) + + uni := -1; + +(* If GetKeyboardState(@KeyStateArray) Then + Begin + scancode := (lParam Shr 16) And $FF; + {todo: ToUnicode (Windows NT)} + tmp := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0); + If (tmp = 1) Or (tmp = 2) Then + Begin + If tmp = 2 Then + Begin +// Writeln('[', AsciiBuf, ']'); {???? todo: dead keys ????} + End + Else + Begin +// Write(Chr(AsciiBuf)); + {todo: codepage -> unicode} + If AsciiBuf <= 126 Then + uni := AsciiBuf; + End; + + End; + End;*) + + { handle key repeat count } + For i := 1 To lParam And $FFFF Do + { create and insert key object } + FEventQueue.AddEvent(TPTCKeyEvent.Create(wParam, uni, m_alt, m_shift, m_control, press)); + + { check multithreaded flag } +(* If m_multithreaded Then + Begin + { set event } + m_event._set; + + { leave monitor } + m_monitor.leave; + End;*) + End; +End; diff --git a/packages/ptc/src/wince/base/wincemoused.inc b/packages/ptc/src/wince/base/wincemoused.inc new file mode 100644 index 0000000000..b60da8bb28 --- /dev/null +++ b/packages/ptc/src/wince/base/wincemoused.inc @@ -0,0 +1,55 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Type + TWinCEMouse = Class(TObject) + Private + FEventQueue : TEventQueue; + + FFullScreen : Boolean; + + { the actual image area, inside the window (top left and bottom right corner) } + FWindowX1, FWindowY1, FWindowX2, FWindowY2 : Integer; + + { console resolution + - mouse cursor position as seen by the user must always be in range: + [0..FConsoleWidth-1, 0..FConsoleHeight-1] } + FConsoleWidth, FConsoleHeight : Integer; + + FPreviousMouseButtonState : TPTCMouseButtonState; + FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas } + FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX, + FPreviousMouseY and FPreviousMouseButtonState contain valid values } + + { flag data } + FEnabled : Boolean; + Public + { setup } + Constructor Create(EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer); + + { window procedure } + Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + + Procedure SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer); + + { control } + Procedure enable; + Procedure disable; + End; diff --git a/packages/ptc/src/wince/base/wincemousei.inc b/packages/ptc/src/wince/base/wincemousei.inc new file mode 100644 index 0000000000..12d60499cb --- /dev/null +++ b/packages/ptc/src/wince/base/wincemousei.inc @@ -0,0 +1,174 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Constructor TWinCEMouse.Create(EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer); + +Begin + FEventQueue := EventQueue; + + FFullScreen := FullScreen; + FConsoleWidth := ConsoleWidth; + FConsoleHeight := ConsoleHeight; + + FPreviousMousePositionSaved := False; + + { enable buffering } + FEnabled := True; +End; + +Procedure TWinCEMouse.SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer); + +Begin + FWindowX1 := WindowX1; + FWindowY1 := WindowY1; + FWindowX2 := WindowX2; + FWindowY2 := WindowY2; +End; + +Procedure TWinCEMouse.enable; + +Begin + { enable buffering } + FEnabled := True; +End; + +Procedure TWinCEMouse.disable; + +Begin + { disable buffering } + FEnabled := False; +End; + +Function TWinCEMouse.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; + +Var + fwKeys : Integer; + xPos, yPos : Integer; + LButton, MButton, RButton : Boolean; + TranslatedXPos, TranslatedYPos : Integer; + PTCMouseButtonState : TPTCMouseButtonState; + WindowRect : RECT; + + button : TPTCMouseButton; + before, after : Boolean; + cstate : TPTCMouseButtonState; + +Begin + Result := 0; + { check enabled flag } + If Not FEnabled Then + Exit; + + If (message = WM_MOUSEMOVE) Or + (message = WM_LBUTTONDOWN) Or (message = WM_LBUTTONUP) Or (message = WM_LBUTTONDBLCLK) Or + (message = WM_MBUTTONDOWN) Or (message = WM_MBUTTONUP) Or (message = WM_MBUTTONDBLCLK) Or + (message = WM_RBUTTONDOWN) Or (message = WM_RBUTTONUP) Or (message = WM_RBUTTONDBLCLK) Then + Begin + fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT} + xPos := lParam And $FFFF; + yPos := (lParam Shr 16) And $FFFF; + + LButton := (fwKeys And MK_LBUTTON) <> 0; + MButton := (fwKeys And MK_MBUTTON) <> 0; + RButton := (fwKeys And MK_RBUTTON) <> 0; + + If Not FFullScreen Then + Begin + GetClientRect(hWnd, WindowRect); + + FWindowX1 := WindowRect.left; + FWindowY1 := WindowRect.top; + FWindowX2 := WindowRect.right - 1; + FWindowY2 := WindowRect.bottom - 1; + End; + + If (xPos >= FWindowX1) And (yPos >= FWindowY1) And + (xPos <= FWindowX2) And (yPos <= FWindowY2) Then + Begin + If FWindowX2 <> FWindowX1 Then + TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth - 1) Div (FWindowX2 - FWindowX1) + Else { avoid div by zero } + TranslatedXPos := 0; + + If FWindowY2 <> FWindowY1 Then + TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) Div (FWindowY2 - FWindowY1) + Else { avoid div by zero } + TranslatedYPos := 0; + + { Just in case... } + If TranslatedXPos < 0 Then + TranslatedXPos := 0; + If TranslatedYPos < 0 Then + TranslatedYPos := 0; + If TranslatedXPos >= FConsoleWidth Then + TranslatedXPos := FConsoleWidth - 1; + If TranslatedYPos >= FConsoleHeight Then + TranslatedYPos := FConsoleHeight - 1; + + If Not LButton Then + PTCMouseButtonState := [] + Else + PTCMouseButtonState := [PTCMouseButton1]; + + If RButton Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2]; + + If MButton Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3]; + + If Not FPreviousMousePositionSaved Then + Begin + FPreviousMouseX := TranslatedXPos; { first DeltaX will be 0 } + FPreviousMouseY := TranslatedYPos; { first DeltaY will be 0 } + FPreviousMouseButtonState := []; + End; + + { movement? } + If (TranslatedXPos <> FPreviousMouseX) Or (TranslatedYPos <> FPreviousMouseY) Then + FEventQueue.AddEvent(TPTCMouseEvent.Create(TranslatedXPos, TranslatedYPos, TranslatedXPos - FPreviousMouseX, TranslatedYPos - FPreviousMouseY, FPreviousMouseButtonState)); + + { button presses/releases? } + cstate := FPreviousMouseButtonState; + For button := Low(button) To High(button) Do + Begin + before := button In FPreviousMouseButtonState; + after := button In PTCMouseButtonState; + If after And (Not before) Then + Begin + { button was pressed } + cstate := cstate + [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, True, button)); + End + Else + If before And (Not after) Then + Begin + { button was released } + cstate := cstate - [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, button)); + End; + End; + + FPreviousMouseX := TranslatedXPos; + FPreviousMouseY := TranslatedYPos; + FPreviousMouseButtonState := PTCMouseButtonState; + FPreviousMousePositionSaved := True; + End; + End; +End; diff --git a/packages/ptc/src/wince/base/wincewindowd.inc b/packages/ptc/src/wince/base/wincewindowd.inc new file mode 100644 index 0000000000..8489aa8811 --- /dev/null +++ b/packages/ptc/src/wince/base/wincewindowd.inc @@ -0,0 +1,21 @@ +Type + TWinCEWndProc = Function(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT Of Object; + + TWinCEWindow = Class(TObject) + Private + FWindow : HWND; + FClassName : WideString; + FClassHInstance : HINST; + Public + Constructor Create(Const AClassName, ATitle : WideString; + AExStyle, AStyle : DWord; + AShow, AX, AY, AWidth, AHeight : Integer; + AWndProc : TWinCEWndProc; + AData : Pointer = Nil); + Destructor Destroy; Override; + + Procedure Close; + Procedure Update; + + Property WindowHandle : HWND Read FWindow; + End; diff --git a/packages/ptc/src/wince/base/wincewindowi.inc b/packages/ptc/src/wince/base/wincewindowi.inc new file mode 100644 index 0000000000..30fe16b61d --- /dev/null +++ b/packages/ptc/src/wince/base/wincewindowi.inc @@ -0,0 +1,182 @@ +Type + PWndProcRegEntry = ^TWndProcRegEntry; + TWndProcRegEntry = Record + WindowHandle : HWND; + Handler : TWinCEWndProc; + End; + +ThreadVar + WndProcRegistry : Array Of TWndProcRegEntry; + WndProcRegistryCache : Integer; + +Procedure WndProcAdd(AWindowHandle : HWND; AHandler : TWinCEWndProc); + +Var + I : Integer; + +Begin + I := Length(WndProcRegistry); + SetLength(WndProcRegistry, I + 1); + WndProcRegistry[I].WindowHandle := AWindowHandle; + WndProcRegistry[I].Handler := AHandler; +End; + +Procedure WndProcRemove(AWindowHandle : HWND); + +Var + I, J : Integer; + +Begin + J := 0; + For I := Low(WndProcRegistry) To High(WndProcRegistry) Do + If WndProcRegistry[I].WindowHandle <> AWindowHandle Then + Begin + WndProcRegistry[J] := WndProcRegistry[I]; + Inc(J); + End; + SetLength(WndProcRegistry, J); +End; + +Function WndProcFind(AWindowHandle : HWND) : TWinCEWndProc; + +Var + I : Integer; + +Begin + If (WndProcRegistryCache >= Low(WndProcRegistry)) And + (WndProcRegistryCache <= High(WndProcRegistry)) And + (WndProcRegistry[WndProcRegistryCache].WindowHandle = AWindowHandle) Then + Begin + Result := WndProcRegistry[WndProcRegistryCache].Handler; + Exit; + End; + + For I := Low(WndProcRegistry) To High(WndProcRegistry) Do + If WndProcRegistry[I].WindowHandle = AWindowHandle Then + Begin + Result := WndProcRegistry[I].Handler; + WndProcRegistryCache := I; + Exit; + End; + Result := Nil; +End; + +Function WinCEWindowProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; CDecl; + +Var + Handler : TWinCEWndProc; + +Begin + Handler := WndProcFind(Ahwnd); + If Handler <> Nil Then + Result := Handler(Ahwnd, AuMsg, AwParam, AlParam) + Else + Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam); +End; + +Constructor TWinCEWindow.Create(Const AClassName, ATitle : WideString; + AExStyle, AStyle : DWord; + AShow, AX, AY, AWidth, AHeight : Integer; + AWndProc : TWinCEWndProc; + AData : Pointer = Nil); + +Var + ClassAtom : ATOM; + wc : WNDCLASSW; + ProgramInstance : HANDLE; + Rectangle : RECT; + X, Y, Width, Height : Integer; + +Begin + ProgramInstance := GetModuleHandleW(Nil); + If ProgramInstance = 0 Then + Raise TPTCError.Create('could not get module handle'); + + LOG('registering window class'); + FillChar(wc, SizeOf(wc), 0); + wc.style := CS_DBLCLKS{ Or CS_HREDRAW Or CS_VREDRAW}; + wc.lpfnWndProc := @WinCEWindowProc; + wc.cbClsExtra := 0; + wc.cbWndExtra := 0; + wc.hInstance := ProgramInstance; + wc.hIcon := 0; { not supported by WinCE } + wc.hCursor := 0; + wc.hbrBackground := 0; + wc.lpszMenuName := Nil; + wc.lpszClassName := PWideChar(AClassName); + ClassAtom := RegisterClassW(@wc); + If ClassAtom = 0 Then + Raise TPTCError.Create('could not register window class'); + FClassName := AClassName; + FClassHInstance := wc.hInstance; + + With Rectangle Do + Begin + left := 0; + top := 0; + right := AWidth; + bottom := AHeight; + End; + If Not AdjustWindowRectEx(@Rectangle, AStyle, False, AExStyle) Then + Raise TPTCError.Create('could not AdjustWindowRectEx'); + + X := AX; + Y := AY; + Width := Rectangle.right - Rectangle.left; + Height := Rectangle.bottom - Rectangle.top; + + FWindow := CreateWindowExW(AExStyle, + PWideChar(AClassName), + PWideChar(ATitle), + AStyle, + X, Y, Width, Height, + 0, 0, 0, + AData); + If (FWindow = 0) Or Not IsWindow(FWindow) Then + Raise TPTCError.Create('could not create window'); + LOG('installing window message handler'); + WndProcAdd(FWindow, AWndProc); + ShowWindow(FWindow, AShow); + If SetFocus(FWindow) = 0 Then + Raise TPTCError.Create('could not set focus to the new window'); + If SetActiveWindow(FWindow) = 0 Then + Raise TPTCError.Create('could not set active window'); + If Not SetForegroundWindow(FWindow) Then + Raise TPTCError.Create('could not set foreground window'); + {...} +End; + +Destructor TWinCEWindow.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TWinCEWindow.Close; + +Begin + If (FWindow <> 0) And IsWindow(FWindow) Then + Begin + WndProcRemove(FWindow); + DestroyWindow(FWindow); + End; + FWindow := 0; + + If FClassName <> '' Then + UnregisterClass(PWideChar(FClassName), FClassHInstance); + FClassName := ''; +End; + +Procedure TWinCEWindow.Update; + +Var + Message : MSG; + +Begin + While PeekMessage(@Message, FWindow, 0, 0, PM_REMOVE) Do + Begin + TranslateMessage(@Message); + DispatchMessage(@Message); + End; +End; diff --git a/packages/ptc/src/wince/gapi/p_gx.pp b/packages/ptc/src/wince/gapi/p_gx.pp new file mode 100644 index 0000000000..10dec8b819 --- /dev/null +++ b/packages/ptc/src/wince/gapi/p_gx.pp @@ -0,0 +1,96 @@ +Unit p_gx; + +{$MODE objfpc} + +{ convention is cdecl for WinCE API} +{$calling cdecl} + +Interface + +Uses + Windows; + +Const + GXDLL = 'gx'; + +Type + GXDisplayProperties = Record + cxWidth : DWord; + cyHeight : DWord; // notice lack of 'th' in the word height. + cbxPitch : LONG; // number of bytes to move right one x pixel - can be negative. + cbyPitch : LONG; // number of bytes to move down one y pixel - can be negative. + cBPP : LONG; // # of bits in each pixel + ffFormat : DWord; // format flags. + End; + + GXKeyList = Record + vkUp : SHORT; // key for up + ptUp : POINT; // x,y position of key/button. Not on screen but in screen coordinates. + vkDown : SHORT; + ptDown : POINT; + vkLeft : SHORT; + ptLeft : POINT; + vkRight : SHORT; + ptRight : POINT; + vkA : SHORT; + ptA : POINT; + vkB : SHORT; + ptB : POINT; + vkC : SHORT; + ptC : POINT; + vkStart : SHORT; + ptStart : POINT; + End; + +Function GXOpenDisplay(AhWnd : HWND; dwFlags : DWORD) : Integer; External GXDLL Name '?GXOpenDisplay@@YAHPAUHWND__@@K@Z'; +Function GXCloseDisplay : Integer; External GXDLL Name '?GXCloseDisplay@@YAHXZ'; +Function GXBeginDraw : Pointer; External GXDLL Name '?GXBeginDraw@@YAPAXXZ'; +Function GXEndDraw : Integer; External GXDLL Name '?GXEndDraw@@YAHXZ'; +Function GXOpenInput : Integer; External GXDLL Name '?GXOpenInput@@YAHXZ'; +Function GXCloseInput : Integer; External GXDLL Name '?GXCloseInput@@YAHXZ'; +Function GXGetDisplayProperties : GXDisplayProperties; External GXDLL Name '?GXGetDisplayProperties@@YA?AUGXDisplayProperties@@XZ'; +Function GXGetDefaultKeys(iOptions : Integer) : GXKeyList; External GXDLL Name '?GXGetDefaultKeys@@YA?AUGXKeyList@@H@Z'; +Function GXSuspend : Integer; External GXDLL Name '?GXSuspend@@YAHXZ'; +Function GXResume : Integer; External GXDLL Name '?GXResume@@YAHXZ'; +Function GXSetViewport(dwTop, dwHeight, dwReserved1, dwReserved2 : DWORD) : Integer; External GXDLL Name '?GXSetViewport@@YAHKKKK@Z'; +Function GXIsDisplayDRAMBuffer : BOOL; External GXDLL Name '?GXIsDisplayDRAMBuffer@@YAHXZ'; + + +// Although these flags can be unrelated they still +// have unique values. + +Const + GX_FULLSCREEN = $01; // for OpenDisplay() + GX_NORMALKEYS = $02; + GX_LANDSCAPEKEYS = $03; + + kfLandscape = $8; // Screen is rotated 270 degrees + kfPalette = $10; // Pixel values are indexes into a palette + kfDirect = $20; // Pixel values contain actual level information + kfDirect555 = $40; // 5 bits each for red, green and blue values in a pixel. + kfDirect565 = $80; // 5 red bits, 6 green bits and 5 blue bits per pixel + kfDirect888 = $100; // 8 bits each for red, green and blue values in a pixel. + kfDirect444 = $200; // 4 red, 4 green, 4 blue + kfDirectInverted = $400; + + GETRAWFRAMEBUFFER = $00020001; + +Type + RawFrameBufferInfo = Record + wFormat : WORD; + wBPP : WORD; + pFramePointer : Pointer; + cxStride : Integer; + cyStride : Integer; + cxPixels : Integer; + cyPixels : Integer; + End; + +Const + FORMAT_565 = 1; + FORMAT_555 = 2; + FORMAT_OTHER = 3; + +Implementation + +End. diff --git a/packages/ptc/src/wince/gapi/wincegapiconsoled.inc b/packages/ptc/src/wince/gapi/wincegapiconsoled.inc new file mode 100644 index 0000000000..c70d52ac6f --- /dev/null +++ b/packages/ptc/src/wince/gapi/wincegapiconsoled.inc @@ -0,0 +1,103 @@ +Type + TWinCEGAPIConsole = Class(TPTCBaseConsole) + Private + FWindow : TWinCEWindow; + FKeyboard : TWinCEKeyboard; + FMouse : TWinCEMouse; + + FGXDisplayProperties : GXDisplayProperties; + + FCopy : TPTCCopy; + FClear : TPTCClear; + FArea : TPTCArea; + FClip : TPTCArea; + FEventQueue : TEventQueue; + FModes : Array[0..1] Of TPTCMode; + + FOpen : Boolean; + FLocked : Boolean; + + FGXDisplayIsOpen : Boolean; + + FTitle : String; + + FDisplayWidth : Integer; + FDisplayHeight : Integer; + FDisplayPitch : Integer; + FDisplayFormat : TPTCFormat; + + Function WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; + + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetPages : Integer; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + + Procedure CheckOpen( AMessage : String); + Procedure CheckUnlocked(AMessage : String); + Public + Constructor Create; Override; + Destructor Destroy; Override; + + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Override; + Procedure Close; Override; + + Procedure Copy(Var ASurface : TPTCBaseSurface); Override; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Override; + + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + + Function Lock : Pointer; Override; + Procedure Unlock; Override; + + Procedure Clear; Override; + Procedure Clear(Const AColor : TPTCColor); Override; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Override; + + Procedure Configure(Const AFileName : String); Override; + Function Option(Const AOption : String) : Boolean; Override; + + Procedure Palette(Const APalette : TPTCPalette); Override; + Procedure Clip(Const AArea : TPTCArea); Override; + Function Clip : TPTCArea; Override; + Function Palette : TPTCPalette; Override; + Function Modes : PPTCMode; Override; + + Procedure Flush; Override; + Procedure Finish; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/wince/gapi/wincegapiconsolei.inc b/packages/ptc/src/wince/gapi/wincegapiconsolei.inc new file mode 100644 index 0000000000..4b5100a188 --- /dev/null +++ b/packages/ptc/src/wince/gapi/wincegapiconsolei.inc @@ -0,0 +1,559 @@ +Constructor TWinCEGAPIConsole.Create; + +Begin + Inherited Create; + + FCopy := TPTCCopy.Create; + FClear := TPTCClear.Create; + FArea := TPTCArea.Create; + FClip := TPTCArea.Create; + + LOG('getting display properties'); + FGXDisplayProperties := GXGetDisplayProperties; + LOG('width=' + IntToStr(FGXDisplayProperties.cxWidth )); + LOG('height=' + IntToStr(FGXDisplayProperties.cyHeight)); + LOG('xpitch=' + IntToStr(FGXDisplayProperties.cbxPitch)); + LOG('ypitch=' + IntToStr(FGXDisplayProperties.cbyPitch)); + LOG('BPP=' + IntToStr(FGXDisplayProperties.cBPP )); + LOG('format=' + IntToStr(FGXDisplayProperties.ffFormat)); + + FDisplayWidth := FGXDisplayProperties.cxWidth; + FDisplayHeight := FGXDisplayProperties.cyHeight; + FDisplayPitch := FGXDisplayProperties.cbyPitch; +// FDisplayFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + FDisplayFormat := TPTCFormat.Create(16, $F800, $07E0, $001F); {hardcoded for now...} + + FModes[0] := TPTCMode.Create(FDisplayWidth, FDisplayHeight, FDisplayFormat); + FModes[1] := TPTCMode.Create; +End; + +Destructor TWinCEGAPIConsole.Destroy; + +Var + I : Integer; + +Begin + Close; + + FCopy.Free; + FClear.Free; + FArea.Free; + FClip.Free; + FDisplayFormat.Free; + + For I := Low(FModes) To High(FModes) Do + FModes[I].Free; + + Inherited Destroy; +End; + +Procedure TWinCEGAPIConsole.Open(Const ATitle : String; APages : Integer = 0); + +Begin + Open(ATitle, FDisplayFormat, APages); +End; + +Procedure TWinCEGAPIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); + +Begin + Open(ATitle, FDisplayWidth, FDisplayHeight, AFormat, APages); +End; + +Procedure TWinCEGAPIConsole.Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); + +Begin + Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages); +End; + +Procedure TWinCEGAPIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); + +Var + tmp : TPTCArea; + +Begin + LOG('TWinCEGAPIConsole.Open'); + + If FOpen Then + Close; + + Try + LOG('creating window'); + FWindow := TWinCEWindow.Create('PTC_GAPI_FULLSCREEN', + ATitle, + 0, + WS_VISIBLE {Or WS_SYSMENU Or WS_CAPTION}, + SW_SHOWNORMAL, + CW_USEDEFAULT, CW_USEDEFAULT, + FDisplayWidth, FDisplayHeight, + @WndProc); + LOG('window created successfully'); + + LOG('opening display'); + If GXOpenDisplay(FWindow.WindowHandle, GX_FULLSCREEN) <> 0 Then + FGXDisplayIsOpen := True {success!!!} + Else + Raise TPTCError.Create('could not open display'); + + tmp := TPTCArea.Create(0, 0, FDisplayWidth, FDisplayHeight); + Try + FArea.Assign(tmp); + FClip.Assign(tmp); + Finally + tmp.Free; + End; + + FEventQueue := TEventQueue.Create; + FKeyboard := TWinCEKeyboard.Create(FEventQueue); + FMouse := TWinCEMouse.Create(FEventQueue, True, FDisplayWidth, FDisplayHeight); + + If {m_primary.m_fullscreen}True Then + FMouse.SetWindowArea(0, 0, FDisplayWidth, FDisplayHeight); + + FWindow.Update; + + FOpen := True; + Except + On error : TObject Do + Begin + Close; + Raise; + End; + End; +End; + +Procedure TWinCEGAPIConsole.Close; + +Begin + LOG('TWinCEGAPIConsole.Close'); + + If FGXDisplayIsOpen Then; + GXCloseDisplay; + FGXDisplayIsOpen := False; + + FreeAndNil(FKeyboard); + FreeAndNil(FMouse); + FreeAndNil(FWindow); + FreeAndNil(FEventQueue); + + FOpen := False; +End; + +Procedure TWinCEGAPIConsole.Copy(Var ASurface : TPTCBaseSurface); + +Begin +End; + +Procedure TWinCEGAPIConsole.Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); + +Begin +End; + +Procedure TWinCEGAPIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + CheckOpen( 'TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + CheckUnlocked('TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + If Clip.Equals(Area) Then + Begin + Try + console_pixels := Lock; + Try + FCopy.Request(AFormat, Format); + FCopy.Palette(APalette, Palette); + FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0, + Width, Height, Pitch); + Finally + Unlock; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TWinCEGAPIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + CheckOpen( 'TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + CheckUnlocked('TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + clipped_source := Nil; + clipped_destination := Nil; + Try + console_pixels := Lock; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination); + Finally + tmp.Free; + End; + FCopy.request(AFormat, Format); + FCopy.palette(APalette, Palette); + FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch); + Finally + Unlock; + clipped_source.Free; + clipped_destination.Free; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console area', error); + End; +End; + +Procedure TWinCEGAPIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin +End; + +Procedure TWinCEGAPIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin +End; + +Function TWinCEGAPIConsole.Lock : Pointer; + +Begin + CheckUnlocked('display already locked'); + Result := GXBeginDraw; + + If Result = Nil Then + Raise TPTCError.Create('the display cannot be locked'); + + FLocked := True; +End; + +Procedure TWinCEGAPIConsole.Unlock; + +Begin + If Not FLocked Then + Raise TPTCError.Create('display is not locked'); + + If GXEndDraw = 0 Then + Raise TPTCError.Create('could not unlock display'); + + FLocked := False; +End; + +Procedure TWinCEGAPIConsole.Clear; + +Begin +End; + +Procedure TWinCEGAPIConsole.Clear(Const AColor : TPTCColor); + +Begin +End; + +Procedure TWinCEGAPIConsole.Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); + +Begin +End; + +Procedure TWinCEGAPIConsole.Configure(Const AFileName : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, AFileName); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + Option(S); + End; + CloseFile(F); +End; + +Function TWinCEGAPIConsole.Option(Const AOption : String) : Boolean; + +Begin + LOG('console option', AOption); + + // todo... + + Result := FCopy.Option(AOption); +End; + +Procedure TWinCEGAPIConsole.Palette(Const APalette : TPTCPalette); + +Begin +End; + +Procedure TWinCEGAPIConsole.Clip(Const AArea : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + CheckOpen('TWinCEGAPIConsole.Clip(AArea)'); + + tmp := TPTCClipper.Clip(AArea, FArea); + Try + FClip.Assign(tmp); + Finally + tmp.Free; + End; +End; + +Function TWinCEGAPIConsole.Clip : TPTCArea; + +Begin + CheckOpen('TWinCEGAPIConsole.Clip'); + Result := FClip; +End; + +Function TWinCEGAPIConsole.Palette : TPTCPalette; + +Begin +End; + +Function TWinCEGAPIConsole.Modes : PPTCMode; + +Begin + Result := @FModes[0]; +End; + +Function TWinCEGAPIConsole.WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; + +Begin + Case AuMsg Of + WM_CLOSE : Begin + LOG('TWinCEGAPIConsole.WndProc: WM_CLOSE'); + Halt(0); + End; + WM_KILLFOCUS : Begin + LOG('TWinCEGAPIConsole.WndProc: WM_KILLFOCUS'); + If FGXDisplayIsOpen Then + GXSuspend; + Result := 0; + Exit; + End; + WM_SETFOCUS : Begin + LOG('TWinCEGAPIConsole.WndProc: WM_SETFOCUS'); + If FGXDisplayIsOpen Then + GXResume; + Result := 0; + Exit; + End; + WM_KEYDOWN, WM_KEYUP : Begin + If FKeyboard <> Nil Then + Result := FKeyboard.WndProc(Ahwnd, AuMsg, AwParam, AlParam) + Else + Result := 0; + Exit; + End; + WM_MOUSEMOVE, + WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK, + WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK, + WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK : Begin + If FMouse <> Nil Then + Result := FMouse.WndProc(Ahwnd, AuMsg, AwParam, AlParam) + Else + Result := 0; + Exit; + End; + + Else + Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam); + End; +End; + +Procedure TWinCEGAPIConsole.Flush; + +Begin + CheckOpen ('TWinCEGAPIConsole.Flush'); + CheckUnlocked('TWinCEGAPIConsole.Flush'); + + Update; +End; + +Procedure TWinCEGAPIConsole.Finish; + +Begin + CheckOpen ('TWinCEGAPIConsole.Finish'); + CheckUnlocked('TWinCEGAPIConsole.Finish'); + + Update; +End; + +Procedure TWinCEGAPIConsole.Update; + +Begin + CheckOpen ('TWinCEGAPIConsole.Update'); + CheckUnlocked('TWinCEGAPIConsole.Update'); + + FWindow.Update; +End; + +Procedure TWinCEGAPIConsole.Update(Const AArea : TPTCArea); + +Begin + Update; +End; + +Function TWinCEGAPIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Begin + CheckOpen('TWinCEGAPIConsole.NextEvent'); +// CheckUnlocked('TWinCEGAPIConsole.NextEvent'); + + FreeAndNil(AEvent); + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + AEvent := FEventQueue.NextEvent(AEventMask); + Until (Not AWait) Or (AEvent <> Nil); + Result := AEvent <> Nil; +End; + +Function TWinCEGAPIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Begin + CheckOpen('TWinCEGAPIConsole.PeekEvent'); +// CheckUnlocked('TWinCEGAPIConsole.PeekEvent'); + + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(AEventMask); + Until (Not AWait) Or (Result <> Nil); +End; + +Function TWinCEGAPIConsole.GetWidth : Integer; + +Begin + CheckOpen('TWinCEGAPIConsole.GetWidth'); + Result := FDisplayWidth; +End; + +Function TWinCEGAPIConsole.GetHeight : Integer; + +Begin + CheckOpen('TWinCEGAPIConsole.GetHeight'); + Result := FDisplayHeight; +End; + +Function TWinCEGAPIConsole.GetPitch : Integer; + +Begin + CheckOpen('TWinCEGAPIConsole.GetPitch'); + Result := FDisplayPitch; +End; + +Function TWinCEGAPIConsole.GetArea : TPTCArea; + +Begin + CheckOpen('TWinCEGAPIConsole.GetArea'); + Result := FArea; +End; + +Function TWinCEGAPIConsole.GetFormat : TPTCFormat; + +Begin + CheckOpen('TWinCEGAPIConsole.GetFormat'); + Result := FDisplayFormat; +End; + +Function TWinCEGAPIConsole.GetPages : Integer; + +Begin + CheckOpen('TWinCEGAPIConsole.GetPages'); + Result := 1; {???} +End; + +Function TWinCEGAPIConsole.GetName : String; + +Begin + Result := 'GAPI'; +End; + +Function TWinCEGAPIConsole.GetTitle : String; + +Begin + CheckOpen('TWinCEGAPIConsole.GetTitle'); + Result := FTitle; +End; + +Function TWinCEGAPIConsole.GetInformation : String; + +Begin + Result := ''; // todo... +End; + +Procedure TWinCEGAPIConsole.CheckOpen( AMessage : String); + +Begin + If Not FOpen Then + Try + Raise TPTCError.Create('console is not open'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; + +Procedure TWinCEGAPIConsole.CheckUnlocked(AMessage : String); + +Begin + If FLocked Then + Try + Raise TPTCError.Create('console is locked'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; diff --git a/packages/ptc/src/wince/gdi/wincebitmapinfod.inc b/packages/ptc/src/wince/gdi/wincebitmapinfod.inc new file mode 100644 index 0000000000..a023431228 --- /dev/null +++ b/packages/ptc/src/wince/gdi/wincebitmapinfod.inc @@ -0,0 +1,17 @@ +Type + TWinCEBitmapInfo = Class(TObject) + Private + FBitmapInfo : PBITMAPINFO; +// FPixels : Pointer; + FFormat : TPTCFormat; + FWidth, FHeight, FPitch : Integer; + Public + Constructor Create(AWidth, AHeight : Integer); + Destructor Destroy; Override; + Property BMI : PBITMAPINFO Read FBitmapInfo; + Property Width : Integer Read FWidth; + Property Height : Integer Read FHeight; + Property Pitch : Integer Read FPitch; + Property Format : TPTCFormat Read FFormat; +// Property Pixels : Pointer Read FPixels; + End; diff --git a/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc b/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc new file mode 100644 index 0000000000..291deacb17 --- /dev/null +++ b/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc @@ -0,0 +1,45 @@ + +{TODO: create DIBs with the same color depth as the desktop} + +Constructor TWinCEBitmapInfo.Create(AWidth, AHeight : Integer); + +Begin + FBitmapInfo := GetMem(SizeOf(BITMAPINFOHEADER) + 12); + + FillChar(FBitmapInfo^.bmiHeader, SizeOf(BITMAPINFOHEADER), 0); + With FBitmapInfo^.bmiHeader Do + Begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := AWidth; + biHeight := -AHeight; + biPlanes := 1; + biBitCount := 32; + biCompression := BI_BITFIELDS; + biSizeImage := 0; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + End; + + PDWord(@FBitmapInfo^.bmiColors)[0] := $FF0000; + PDWord(@FBitmapInfo^.bmiColors)[1] := $00FF00; + PDWord(@FBitmapInfo^.bmiColors)[2] := $0000FF; + + FWidth := AWidth; + FHeight := AHeight; + FFormat := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + FPitch := FWidth * 4; + +// FPixels := GetMem(AWidth * AHeight * 4); +// FillChar(FPixels^, AWidth * AHeight * 4, 0); +End; + +Destructor TWinCEBitmapInfo.Destroy; + +Begin +// FreeMem(FPixels); + FreeMem(FBitmapInfo); + FFormat.Free; + Inherited Destroy; +End; diff --git a/packages/ptc/src/wince/gdi/wincegdiconsoled.inc b/packages/ptc/src/wince/gdi/wincegdiconsoled.inc new file mode 100644 index 0000000000..4861b5d8ff --- /dev/null +++ b/packages/ptc/src/wince/gdi/wincegdiconsoled.inc @@ -0,0 +1,100 @@ +Type + TWinCEGDIConsole = Class(TPTCBaseConsole) + Private + FWindow : TWinCEWindow; + FBitmap : HBitmap; + FBitmapInfo : TWinCEBitmapInfo; + FBitmapPixels : Pointer; + FKeyboard : TWinCEKeyboard; + FMouse : TWinCEMouse; + + FCopy : TPTCCopy; + FClear : TPTCClear; + FArea : TPTCArea; + FClip : TPTCArea; + FEventQueue : TEventQueue; + + FOpen : Boolean; + FLocked : Boolean; + + FTitle : String; + + FDefaultWidth : Integer; + FDefaultHeight : Integer; + FDefaultFormat : TPTCFormat; + + Function WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; + + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetPages : Integer; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + + Procedure CheckOpen( AMessage : String); + Procedure CheckUnlocked(AMessage : String); + Public + Constructor Create; Override; + Destructor Destroy; Override; + + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Override; + Procedure Close; Override; + + Procedure Copy(Var ASurface : TPTCBaseSurface); Override; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Override; + + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + + Function Lock : Pointer; Override; + Procedure Unlock; Override; + + Procedure Clear; Override; + Procedure Clear(Const AColor : TPTCColor); Override; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Override; + + Procedure Configure(Const AFileName : String); Override; + Function Option(Const AOption : String) : Boolean; Override; + + Procedure Palette(Const APalette : TPTCPalette); Override; + Procedure Clip(Const AArea : TPTCArea); Override; + Function Clip : TPTCArea; Override; + Function Palette : TPTCPalette; Override; + Function Modes : PPTCMode; Override; + + Procedure Flush; Override; + Procedure Finish; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/wince/gdi/wincegdiconsolei.inc b/packages/ptc/src/wince/gdi/wincegdiconsolei.inc new file mode 100644 index 0000000000..f6a05fef87 --- /dev/null +++ b/packages/ptc/src/wince/gdi/wincegdiconsolei.inc @@ -0,0 +1,565 @@ +Constructor TWinCEGDIConsole.Create; + +Begin + Inherited Create; + + FDefaultWidth := 320; + FDefaultHeight := 200; + FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF); + + FCopy := TPTCCopy.Create; + FClear := TPTCClear.Create; + FArea := TPTCArea.Create; + FClip := TPTCArea.Create; +End; + +Destructor TWinCEGDIConsole.Destroy; + +Begin + Close; + + FWindow.Free; + + FEventQueue.Free; + FCopy.Free; + FClear.Free; + FArea.Free; + FClip.Free; + FDefaultFormat.Free; + + Inherited Destroy; +End; + +Procedure TWinCEGDIConsole.Open(Const ATitle : String; APages : Integer = 0); + +Begin + Open(ATitle, FDefaultFormat, APages); +End; + +Procedure TWinCEGDIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); + +Begin + Open(ATitle, FDefaultWidth, FDefaultHeight, AFormat, APages); +End; + +Procedure TWinCEGDIConsole.Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); + +Begin + Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages); +End; + +Procedure TWinCEGDIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); + +Var + DeviceContext : HDC; + tmp : TPTCArea; + +Begin + LOG('TWinCEGDIConsole.Open'); + + If FBitmap <> 0 Then + Begin + DeleteObject(FBitmap); + FBitmap := 0; + End; + FreeAndNil(FWindow); + FreeAndNil(FBitmapInfo); + FreeAndNil(FKeyboard); + FreeAndNil(FMouse); + FreeAndNil(FEventQueue); + + LOG('creating window'); + FWindow := TWinCEWindow.Create('PTC_GDI_WINDOWED_FIXED', + ATitle, + 0, + WS_VISIBLE {Or WS_SYSMENU Or WS_CAPTION}, + SW_SHOWNORMAL, + CW_USEDEFAULT, CW_USEDEFAULT, + AWidth, AHeight, + @WndProc); + LOG('window created successfully'); + + FBitmapInfo := TWinCEBitmapInfo.Create(AWidth, AHeight); + + LOG('trying to create a dib section'); + DeviceContext := GetDC(FWindow.WindowHandle); + If DeviceContext = 0 Then + Raise TPTCError.Create('could not get device context of window'); + FBitmap := CreateDIBSection(DeviceContext, + FBitmapInfo.BMI^, + DIB_RGB_COLORS, + FBitmapPixels, + 0, 0); + ReleaseDC(FWindow.WindowHandle, DeviceContext); + If FBitmap = 0 Then + Raise TPTCError.Create('could not create dib section'); + + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + FArea.Assign(tmp); + FClip.Assign(tmp); + Finally + tmp.Free; + End; + + FEventQueue := TEventQueue.Create; + FKeyboard := TWinCEKeyboard.Create(FEventQueue); + FMouse := TWinCEMouse.Create(FEventQueue, False, AWidth, AHeight); + + FWindow.Update; + + {todo...} + FOpen := True; + LOG('console open succeeded'); +End; + +Procedure TWinCEGDIConsole.Close; + +Begin + LOG('TWinCEGDIConsole.Close'); + + FreeAndNil(FKeyboard); + FreeAndNil(FMouse); + FreeAndNil(FEventQueue); + + FBitmapPixels := Nil; { just in case... } + FreeAndNil(FBitmapInfo); + If FBitmap <> 0 Then + Begin + DeleteObject(FBitmap); + FBitmap := 0; + End; + FreeAndNil(FWindow); + + {todo...} + + FOpen := False; +End; + +Procedure TWinCEGDIConsole.Copy(Var ASurface : TPTCBaseSurface); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + CheckOpen( 'TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + CheckUnlocked('TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)'); + If Clip.Equals(Area) Then + Begin + Try + console_pixels := Lock; + Try + FCopy.Request(AFormat, Format); + FCopy.Palette(APalette, Palette); + FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0, + Width, Height, Pitch); + Finally + Unlock; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TWinCEGDIConsole.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + CheckOpen( 'TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + CheckUnlocked('TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)'); + clipped_source := Nil; + clipped_destination := Nil; + Try + console_pixels := Lock; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination); + Finally + tmp.Free; + End; + FCopy.request(AFormat, Format); + FCopy.palette(APalette, Palette); + FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch); + Finally + Unlock; + clipped_source.Free; + clipped_destination.Free; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console area', error); + End; +End; + +Procedure TWinCEGDIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + {todo...} +End; + +Function TWinCEGDIConsole.Lock : Pointer; + +Begin + Result := FBitmapPixels; // todo... + FLocked := True; +End; + +Procedure TWinCEGDIConsole.Unlock; + +Begin + FLocked := False; +End; + +Procedure TWinCEGDIConsole.Clear; + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Clear(Const AColor : TPTCColor); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Configure(Const AFileName : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, AFileName); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + Option(S); + End; + CloseFile(F); +End; + +Function TWinCEGDIConsole.Option(Const AOption : String) : Boolean; + +Begin + LOG('console option', AOption); + + // todo... + + Result := FCopy.Option(AOption); +End; + +Procedure TWinCEGDIConsole.Palette(Const APalette : TPTCPalette); + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Clip(Const AArea : TPTCArea); + +Var + tmp : TPTCArea; + +Begin + CheckOpen('TWinCEGDIConsole.Clip(AArea)'); + + tmp := TPTCClipper.Clip(AArea, FArea); + Try + FClip.Assign(tmp); + Finally + tmp.Free; + End; +End; + +Function TWinCEGDIConsole.Clip : TPTCArea; + +Begin + CheckOpen('TWinCEGDIConsole.Clip'); + Result := FClip; +End; + +Function TWinCEGDIConsole.Palette : TPTCPalette; + +Begin + {todo...} +End; + +Function TWinCEGDIConsole.Modes : PPTCMode; + +Begin + // todo... + Result := Nil; +End; + +Procedure TWinCEGDIConsole.Flush; + +Begin + {todo...} +End; + +Procedure TWinCEGDIConsole.Finish; + +Begin + {todo...} +End; + +Function TWinCEGDIConsole.WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; + +Begin + Case AuMsg Of + WM_CLOSE : Begin + LOG('TWinCEGDIConsole.WndProc: WM_CLOSE'); + Halt(0); + End; + WM_KEYDOWN, WM_KEYUP : Begin + If FKeyboard <> Nil Then + Result := FKeyboard.WndProc(Ahwnd, AuMsg, AwParam, AlParam) + Else + Result := 0; + Exit; + End; + WM_MOUSEMOVE, + WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK, + WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK, + WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK : Begin + If FMouse <> Nil Then + Result := FMouse.WndProc(Ahwnd, AuMsg, AwParam, AlParam) + Else + Result := 0; + Exit; + End; + Else + Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam); + End; +End; + +Procedure TWinCEGDIConsole.Update; + +Var + ClientRect : RECT; + DeviceContext, DeviceContext2 : HDC; + +Begin + CheckOpen( 'TWinCEGDIConsole.Update'); + CheckUnlocked('TWinCEGDIConsole.Update'); + + FWindow.Update; + + DeviceContext := GetDC(FWindow.WindowHandle); + + If DeviceContext <> 0 Then + Begin + If GetClientRect(FWindow.WindowHandle, @ClientRect) Then + Begin + DeviceContext2 := CreateCompatibleDC(DeviceContext); + If DeviceContext2 <> 0 Then + Begin + SelectObject(DeviceContext2, FBitmap); + + StretchBlt(DeviceContext, + 0, 0, ClientRect.right, ClientRect.bottom, + DeviceContext2, + 0, 0, FBitmapInfo.Width, FBitmapInfo.Height, + SRCCOPY); + + DeleteDC(DeviceContext2); + End; + End; + + ReleaseDC(FWindow.WindowHandle, DeviceContext); + End; +End; + +Procedure TWinCEGDIConsole.Update(Const AArea : TPTCArea); + +Begin + {todo...} + Update; +End; + +Function TWinCEGDIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Begin + CheckOpen('TWinCEGDIConsole.NextEvent'); +// CheckUnlocked('TWinCEGDIConsole.NextEvent'); + + FreeAndNil(AEvent); + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + AEvent := FEventQueue.NextEvent(AEventMask); + Until (Not AWait) Or (AEvent <> Nil); + Result := AEvent <> Nil; +End; + +Function TWinCEGDIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Begin + CheckOpen('TWinCEGDIConsole.PeekEvent'); +// CheckUnlocked('TWinCEGDIConsole.PeekEvent'); + + Repeat + { update window } + FWindow.Update; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(AEventMask); + Until (Not AWait) Or (Result <> Nil); +End; + +Function TWinCEGDIConsole.GetWidth : Integer; + +Begin + CheckOpen('TWinCEGDIConsole.GetWidth'); + Result := FBitmapInfo.Width; +End; + +Function TWinCEGDIConsole.GetHeight : Integer; + +Begin + CheckOpen('TWinCEGDIConsole.GetHeight'); + Result := FBitmapInfo.Height; +End; + +Function TWinCEGDIConsole.GetPitch : Integer; + +Begin + CheckOpen('TWinCEGDIConsole.GetPitch'); + Result := FBitmapInfo.Pitch; +End; + +Function TWinCEGDIConsole.GetFormat : TPTCFormat; + +Begin + CheckOpen('TWinCEGDIConsole.GetFormat'); + Result := FBitmapInfo.Format; +End; + +Function TWinCEGDIConsole.GetArea : TPTCArea; + +Begin + CheckOpen('TWinCEGDIConsole.GetArea'); + Result := FArea; +End; + +Function TWinCEGDIConsole.GetPages : Integer; + +Begin + CheckOpen('TWinCEGDIConsole.GetPages'); + Result := 2; +End; + +Function TWinCEGDIConsole.GetName : String; + +Begin + Result := 'WinCE'; +End; + +Function TWinCEGDIConsole.GetTitle : String; + +Begin + CheckOpen('TWinCEGDIConsole.GetTitle'); + Result := FTitle; +End; + +Function TWinCEGDIConsole.GetInformation : String; + +Begin + CheckOpen('TWinCEGDIConsole.GetInformation'); + Result := ''; // todo... +End; + +Procedure TWinCEGDIConsole.CheckOpen(AMessage : String); + +Begin + If Not FOpen Then + Try + Raise TPTCError.Create('console is not open'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; + +Procedure TWinCEGDIConsole.CheckUnlocked(AMessage : String); + +Begin + If FLocked Then + Try + Raise TPTCError.Create('console is locked'); + Except + On error : TPTCError Do + Raise TPTCError.Create(AMessage, error); + End; +End; diff --git a/packages/ptc/src/wince/includes.inc b/packages/ptc/src/wince/includes.inc new file mode 100644 index 0000000000..97e26580d7 --- /dev/null +++ b/packages/ptc/src/wince/includes.inc @@ -0,0 +1,13 @@ +{$INCLUDE base/wincewindowd.inc} +{$INCLUDE base/wincekeyboardd.inc} +{$INCLUDE base/wincemoused.inc} +{$INCLUDE gdi/wincebitmapinfod.inc} +{$INCLUDE gdi/wincegdiconsoled.inc} +{$INCLUDE gapi/wincegapiconsoled.inc} + +{$INCLUDE base/wincewindowi.inc} +{$INCLUDE base/wincekeyboardi.inc} +{$INCLUDE base/wincemousei.inc} +{$INCLUDE gdi/wincebitmapinfoi.inc} +{$INCLUDE gdi/wincegdiconsolei.inc} +{$INCLUDE gapi/wincegapiconsolei.inc} diff --git a/packages/ptc/src/x11/check.inc b/packages/ptc/src/x11/check.inc new file mode 100644 index 0000000000..52f20ef718 --- /dev/null +++ b/packages/ptc/src/x11/check.inc @@ -0,0 +1,63 @@ +{ + Free Pascal port of the OpenPTC C++ library. + Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net) + Original C++ version by Glenn Fiedler (ptc@gaffer.org) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +Procedure X11Check(result : TStatus); + +{Var + ErrStr : String;} + +Begin + {todo: fix X11 error handling} +{ If result = Success Then + Exit; + Case result Of + BadRequest : ErrStr := 'BadRequest'; + BadValue : ErrStr := 'BadValue'; + BadWindow : ErrStr := 'BadWindow'; + BadPixmap : ErrStr := 'BadPixmap'; + BadAtom : ErrStr := 'BadAtom'; + BadCursor : ErrStr := 'BadCursor'; + BadFont : ErrStr := 'BadFont'; + BadMatch : ErrStr := 'BadMatch'; + BadDrawable : ErrStr := 'BadDrawable'; + BadAccess : ErrStr := 'BadAccess'; + BadAlloc : ErrStr := 'BadAlloc'; + BadColor : ErrStr := 'BadColor'; + BadGC : ErrStr := 'BadGC'; + BadIDChoice : ErrStr := 'BadIDChoice'; + BadName : ErrStr := 'BadName'; + BadLength : ErrStr := 'BadLength'; + BadImplementation : ErrStr := 'BadImplementation'; + Else + Str(result, ErrStr); + End; + Raise TPTCError.Create('X11 Error: ' + ErrStr);} +End; + +Procedure X11Check(result : TStatus; Const message : String); + +Begin + Try + X11Check(result); + Except + On error : TPTCError Do + Raise TPTCError.Create(message, error); + End; +End; diff --git a/packages/ptc/src/x11/extensions.inc b/packages/ptc/src/x11/extensions.inc new file mode 100644 index 0000000000..9ecfbff4d8 --- /dev/null +++ b/packages/ptc/src/x11/extensions.inc @@ -0,0 +1,6 @@ +{ X11 extensions we want to enable at compile time } +{$DEFINE ENABLE_X11_EXTENSION_XRANDR} +{$DEFINE ENABLE_X11_EXTENSION_XF86VIDMODE} +{$DEFINE ENABLE_X11_EXTENSION_XF86DGA1} +{$DEFINE ENABLE_X11_EXTENSION_XF86DGA2} +{$DEFINE ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/includes.inc b/packages/ptc/src/x11/includes.inc new file mode 100644 index 0000000000..f6a0301ded --- /dev/null +++ b/packages/ptc/src/x11/includes.inc @@ -0,0 +1,16 @@ +{$INCLUDE x11modesd.inc} +{$INCLUDE x11imaged.inc} +{$INCLUDE x11displayd.inc} +{$INCLUDE x11windowdisplayd.inc} +{$INCLUDE x11dga1displayd.inc} +{$INCLUDE x11dga2displayd.inc} +{$INCLUDE x11consoled.inc} + +{$INCLUDE check.inc} +{$INCLUDE x11modesi.inc} +{$INCLUDE x11imagei.inc} +{$INCLUDE x11displayi.inc} +{$INCLUDE x11windowdisplayi.inc} +{$INCLUDE x11dga1displayi.inc} +{$INCLUDE x11dga2displayi.inc} +{$INCLUDE x11consolei.inc} diff --git a/packages/ptc/src/x11/x11consoled.inc b/packages/ptc/src/x11/x11consoled.inc new file mode 100644 index 0000000000..872698cc37 --- /dev/null +++ b/packages/ptc/src/x11/x11consoled.inc @@ -0,0 +1,82 @@ +Type + TX11Console = Class(TPTCBaseConsole) + Private + FX11Display : TX11Display; + FTitle : String; + FFlags : TX11Flags; + FModes : Array Of TPTCMode; + + Procedure UpdateCursor; + + Function CreateDisplay : TX11Display; { Factory method } + + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Function GetPitch : Integer; Override; + Function GetArea : TPTCArea; Override; + Function GetFormat : TPTCFormat; Override; + Function GetPages : Integer; Override; + Function GetName : String; Override; + Function GetTitle : String; Override; + Function GetInformation : String; Override; + Public + Constructor Create; Override; + Destructor Destroy; Override; + + Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override; + Procedure Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); Overload; Override; + Procedure Close; Override; + + Procedure Copy(Var ASurface : TPTCBaseSurface); Override; + Procedure Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); Override; + + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); Override; + Procedure Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Override; + + Function Lock : Pointer; Override; + Procedure Unlock; Override; + + Procedure Clear; Override; + Procedure Clear(Const AColor : TPTCColor); Override; + Procedure Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); Override; + + Procedure Configure(Const AFileName : String); Override; + Function Option(Const AOption : String) : Boolean; Override; + + Procedure Palette(Const APalette : TPTCPalette); Override; + Procedure Clip(Const AArea : TPTCArea); Override; + Function Clip : TPTCArea; Override; + Function Palette : TPTCPalette; Override; + Function Modes : PPTCMode; Override; + + Procedure Flush; Override; + Procedure Finish; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + End; diff --git a/packages/ptc/src/x11/x11consolei.inc b/packages/ptc/src/x11/x11consolei.inc new file mode 100644 index 0000000000..1e9ccd0c46 --- /dev/null +++ b/packages/ptc/src/x11/x11consolei.inc @@ -0,0 +1,530 @@ +Constructor TX11Console.Create; + +Var + s : AnsiString; + +Begin + Inherited Create; + + { default flags } + FFlags := [PTC_X11_TRY_XSHM, PTC_X11_TRY_XF86VIDMODE]; + + FTitle := ''; + + Configure('/usr/share/ptcpas/ptcpas.conf'); + s := fpgetenv('HOME'); + If s = '' Then + s := '/'; + If s[Length(s)] <> '/' Then + s := s + '/'; + s := s + '.ptcpas.conf'; + Configure(s); +End; + +Destructor TX11Console.Destroy; + +Var + I : Integer; + +Begin + Close; + FreeAndNil(FX11Display); + For I := Low(FModes) To High(FModes) Do + FreeAndNil(FModes[I]); + Inherited Destroy; +End; + +Procedure TX11Console.Configure(Const AFileName : String); + +Var + F : Text; + S : String; + +Begin + AssignFile(F, AFileName); + {$I-} + Reset(F); + {$I+} + If IOResult <> 0 Then + Exit; + While Not EoF(F) Do + Begin + {$I-} + Readln(F, S); + {$I+} + If IOResult <> 0 Then + Break; + Option(S); + End; + CloseFile(F); +End; + +Function TX11Console.Option(Const AOption : String) : Boolean; + +Begin + Result := True; + If AOption = 'default output' Then + Begin + { default is windowed for now } + FFlags := FFlags - [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'windowed output' Then + Begin + FFlags := FFlags - [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'fullscreen output' Then + Begin + FFlags := FFlags + [PTC_X11_FULLSCREEN]; + Exit; + End; + If AOption = 'leave window open' Then + Begin + FFlags := FFlags + [PTC_X11_LEAVE_WINDOW]; + Exit; + End; + If AOption = 'leave display open' Then + Begin + FFlags := FFlags + [PTC_X11_LEAVE_DISPLAY]; + Exit; + End; + If AOption = 'dga' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_DGA]; + Exit; + End; + If AOption = 'dga off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_DGA]; + Exit; + End; + If AOption = 'xf86vidmode' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XF86VIDMODE]; + Exit; + End; + If AOption = 'xf86vidmode off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XF86VIDMODE]; + Exit; + End; + If AOption = 'xrandr' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XRANDR]; + Exit; + End; + If AOption = 'xrandr off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XRANDR]; + Exit; + End; + If AOption = 'xshm' Then + Begin + FFlags := FFlags + [PTC_X11_TRY_XSHM]; + Exit; + End; + If AOption = 'xshm off' Then + Begin + FFlags := FFlags - [PTC_X11_TRY_XSHM]; + Exit; + End; + If AOption = 'default cursor' Then + Begin + FFlags := FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'show cursor' Then + Begin + FFlags := (FFlags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'hide cursor' Then + Begin + FFlags := (FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE]; + UpdateCursor; + Exit; + End; + If AOption = 'enable logging' Then + Begin + LOG_enabled := True; + Result := True; + Exit; + End; + If AOption = 'disable logging' Then + Begin + LOG_enabled := False; + Result := True; + Exit; + End; + + If Assigned(FX11Display) Then + Result := FX11Display.FCopy.Option(AOption) + Else + Result := False; +End; + +Function TX11Console.Modes : PPTCMode; + +Var + I : Integer; + +Begin + For I := Low(FModes) To High(FModes) Do + FreeAndNil(FModes[I]); + + If FX11Display = Nil Then + FX11Display := CreateDisplay; + + FX11Display.GetModes(FModes); + + Result := @FModes[0]; +End; + +{TODO: Find current pixel depth} +Procedure TX11Console.Open(Const ATitle : String; APages : Integer = 0); + +Var + tmp : TPTCFormat; + +Begin + tmp := TPTCFormat.Create(32, $FF0000, $FF00, $FF); + Try + Open(ATitle, tmp, APages); + Finally + tmp.Free; + End; +End; + +Procedure TX11Console.Open(Const ATitle : String; Const AFormat : TPTCFormat; + APages : Integer = 0); + +Begin + Open(ATitle, 640, 480, AFormat, APages); +End; + +Procedure TX11Console.Open(Const ATitle : String; Const AMode : TPTCMode; + APages : Integer = 0); + +Begin + Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages); +End; + +Function TX11Console.CreateDisplay : TX11Display; + +Var + display : PDisplay; + screen : Integer; + +Begin + { Check if we can open an X display } + display := XOpenDisplay(Nil); + If display = Nil Then + Raise TPTCError.Create('Cannot open X display'); + + { DefaultScreen should be fine } + screen := DefaultScreen(display); + + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + If PTC_X11_TRY_DGA In FFlags Then + Begin + Try + Result := TX11DGA2Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]); + Result.SetFlags(FFlags); + Exit; + Except + LOG('DGA 2.0 failed'); + End; + End; + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} + + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + If PTC_X11_TRY_DGA In FFlags Then + Begin + Try + Result := TX11DGA1Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]); + Result.SetFlags(FFlags); + Except + LOG('DGA 1.0 failed'); + End; + End; + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} + + Result := TX11WindowDisplay.Create(display, screen, FFlags); +End; + +Procedure TX11Console.Open(Const ATitle : String; AWidth, AHeight : Integer; + Const AFormat : TPTCFormat; APages : Integer = 0); + +Begin + Close; + FTitle := ATitle; + + If FX11Display = Nil Then + FX11Display := CreateDisplay; + FX11Display.Open(ATitle, AWidth, AHeight, AFormat); + + UpdateCursor; +End; + +Procedure TX11Console.Close; + +Begin + FreeAndNil(FX11Display); +End; + +Procedure TX11Console.Flush; + +Begin + Update; +End; + +Procedure TX11Console.Finish; + +Begin + Update; +End; + +Procedure TX11Console.Update; + +Begin + FX11Display.Update; +End; + +Procedure TX11Console.Update(Const AArea : TPTCArea); + +Begin + FX11Display.Update(AArea); +End; + +Function TX11Console.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Begin + Result := FX11Display.NextEvent(AEvent, AWait, AEventMask); +End; + +Function TX11Console.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Begin + Result := FX11Display.PeekEvent(AWait, AEventMask); +End; + +Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface); + +Begin + {todo!...} +End; + +Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface; + Const ASource, ADestination : TPTCArea); + +Begin + {todo!...} +End; + +Function TX11Console.Lock : Pointer; + +Begin + Result := FX11Display.Lock; +End; + +Procedure TX11Console.Unlock; + +Begin + FX11Display.Unlock; +End; + +Procedure TX11Console.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette); +End; + +Procedure TX11Console.Load(Const APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination); +End; + +Procedure TX11Console.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette); + +Begin + {todo!...} +End; + +Procedure TX11Console.Save(APixels : Pointer; + AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; + Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin + {todo!...} +End; + +Procedure TX11Console.Clear; + +Var + tmp : TPTCColor; + +Begin + If Format.Direct Then + tmp := TPTCColor.Create(0, 0, 0, 0) + Else + tmp := TPTCColor.Create(0); + Try + Clear(tmp); + Finally + tmp.Free; + End; +End; + +Procedure TX11Console.Clear(Const AColor : TPTCColor); + +Begin + FX11Display.Clear(AColor); +End; + +Procedure TX11Console.Clear(Const AColor : TPTCColor; + Const AArea : TPTCArea); + +Begin + FX11Display.Clear(AColor, AArea); +End; + +Procedure TX11Console.Palette(Const APalette : TPTCPalette); + +Begin + FX11Display.Palette(APalette); +End; + +Function TX11Console.Palette : TPTCPalette; + +Begin + Result := FX11Display.Palette; +End; + +Procedure TX11Console.Clip(Const AArea : TPTCArea); + +Begin + FX11Display.Clip(AArea); +End; + +Function TX11Console.GetWidth : Integer; + +Begin + Result := FX11Display.Width; +End; + +Function TX11Console.GetHeight : Integer; + +Begin + Result := FX11Display.Height; +End; + +Function TX11Console.GetPitch : Integer; + +Begin + Result := FX11Display.Pitch; +End; + +Function TX11Console.GetPages : Integer; + +Begin + Result := 2; +End; + +Function TX11Console.GetArea : TPTCArea; + +Begin + Result := FX11Display.Area; +End; + +Function TX11Console.Clip : TPTCArea; + +Begin + Result := FX11Display.Clip; +End; + +Function TX11Console.GetFormat : TPTCFormat; + +Begin + Result := FX11Display.Format; +End; + +Function TX11Console.GetName : String; + +Begin + Result := 'X11'; +End; + +Function TX11Console.GetTitle : String; + +Begin + Result := FTitle; +End; + +Function TX11Console.GetInformation : String; + +Begin + If FX11Display = Nil Then + Exit('PTC X11'); + Result := 'PTC X11, '; + If FX11Display.IsFullScreen Then + Result := Result + 'fullscreen ' + Else + Result := Result + 'windowed '; + + { TODO: use virtual methods, instead of "is" } + If FX11Display Is TX11WindowDisplay Then + Begin + If TX11WindowDisplay(FX11Display).FPrimary <> Nil Then + Result := Result + '(' + TX11WindowDisplay(FX11Display).FPrimary.Name + ') ' + Else + Result := Result + ''; + End + Else + Begin + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + If FX11Display Is TX11DGA2Display Then + Result := Result + '(DGA) ' + Else + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} + {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + If FX11Display Is TX11DGA1Display Then + Result := Result + '(DGA) ' + Else + {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} + Begin + {...} + End; + End; + Result := Result + 'mode, ' + + IntToStr(FX11Display.Width) + 'x' + + IntToStr(FX11Display.Height) + ', ' + + IntToStr(FX11Display.Format.Bits) + ' bit'; +End; + +Procedure TX11Console.UpdateCursor; + +Begin + If Assigned(FX11Display) Then + Begin + If FX11Display.IsFullScreen Then + FX11Display.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In FFlags) + Else + FX11Display.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In FFlags)); + End; +End; diff --git a/packages/ptc/src/x11/x11dga1displayd.inc b/packages/ptc/src/x11/x11dga1displayd.inc new file mode 100644 index 0000000000..6abfd2cb35 --- /dev/null +++ b/packages/ptc/src/x11/x11dga1displayd.inc @@ -0,0 +1,45 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + +Type + TX11DGA1Display = Class(TX11Display) + Private + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + FModeInfo : PPXF86VidModeModeInfo; + FModeInfoNum : Integer; + FPreviousMode : Integer; + + FDGAAddr : PByte; + FDGALineWidth : Integer; + FDGABankSize : Integer; + FDGAMemSize : Integer; + FDGAWidth, FDGAHeight : Integer; + + { Coordinates of upper left frame corner } + FDestX, FDestY : Integer; + + FInDirect, FInMode : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Override; + Procedure Close; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + Function Lock : Pointer; Override; + Procedure Unlock; Override; + Procedure Palette(Const APalette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function GetX11Window : TWindow; Override; + Function IsFullScreen : Boolean; Override; + Procedure SetCursor(AVisible : Boolean); Override; + End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} diff --git a/packages/ptc/src/x11/x11dga1displayi.inc b/packages/ptc/src/x11/x11dga1displayi.inc new file mode 100644 index 0000000000..1eb4ba1ae0 --- /dev/null +++ b/packages/ptc/src/x11/x11dga1displayi.inc @@ -0,0 +1,507 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} + +Constructor TX11DGA1Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Var + dummy1, dummy2 : Integer; + +Begin + Inherited; + + LOG('trying to create a DGA 1.0 display'); + + FInDirect := False; + FInMode := False; + FModeInfo := Nil; + + { Check if we are root } + If fpgeteuid <> 0 Then + Raise TPTCError.Create('Have to be root to switch to DGA mode'); + + { Check if the DGA extension and VidMode extension can be used } + If Not XF86DGAQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); + If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); +End; + +Destructor TX11DGA1Display.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11DGA1Display.Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + +Var + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + root : TWindow; + e : TXEvent; + found : Boolean; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + FWidth := AWidth; + FHeight := AHeight; + + { Get all availabe video modes } + XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeInfoNum, @FModeInfo); + + FPreviousMode := -1; + { Save previous mode } + New(vml); + Try + XF86VidModeGetModeLine(FDisplay, FScreen, @dotclock, vml); + Try + For i := 0 To FModeInfoNum - 1 Do + Begin + If (vml^.hdisplay = FModeInfo[i]^.hdisplay) And + (vml^.vdisplay = FModeInfo[i]^.vdisplay) Then + Begin + FPreviousMode := i; + Break; + End; + End; + Finally + If vml^.privsize <> 0 Then + XFree(vml^.c_private); + End; + Finally + Dispose(vml); + End; + If FPreviousMode = -1 Then + Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)'); + + { Find a video mode to set } + + { Normal modesetting first, find exactly matching mode } + found_mode := -1; + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay = AWidth) And (FModeInfo[i]^.vdisplay = AHeight) Then + Begin + found_mode := i; + Break; + End; + + { Try to find a mode that matches the width first } + If found_mode = -1 Then + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay = AWidth) And + (FModeInfo[i]^.vdisplay >= AHeight) Then + Begin + found_mode := i; + Break; + End; + + { Next try to match the height } + If found_mode = -1 Then + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay >= AWidth) And + (FModeInfo[i]^.vdisplay = AHeight) Then + Begin + found_mode := i; + Break; + End; + + If found_mode = -1 Then + Begin + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + min_diff := 987654321; + For i := 0 To FModeInfoNum - 1 Do + If (FModeInfo[i]^.hdisplay >= AWidth) And (FModeInfo[i]^.vdisplay >= AHeight) Then + Begin + d_x := Sqr(FModeInfo[i]^.hdisplay - AWidth); + d_y := Sqr(FModeInfo[i]^.vdisplay - AHeight); + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := i; + End; + End; + End; + + If found_mode = -1 Then + Raise TPTCError.Create('Cannot find a video mode to use'); + + If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[found_mode]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + FDestX := (FModeInfo[found_mode]^.hdisplay Div 2) - (AWidth Div 2); + FDestY := (FModeInfo[found_mode]^.vdisplay Div 2) - (AHeight Div 2); + + XFlush(FDisplay); + FInMode := True; + + { Check if the requested colour mode is available } + FFormat := GetX11Format(AFormat); + + { Grab exclusive control over the keyboard and mouse } + root := XRootWindow(FDisplay, FScreen); + XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime); + XFlush(FDisplay); + + { Get Display information } + XF86DGAGetVideo(FDisplay, FScreen, @FDGAAddr, @FDGALineWidth, + @FDGABankSize, @FDGAMemSize); + + { Don't have to be root anymore } +{ fpsetuid(fpgetuid);...} + + XF86DGAGetViewPortSize(FDisplay, FScreen, @FDGAWidth, @FDGAHeight); + + If XF86DGAForkApp(FScreen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork'); + + If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + + FInDirect := True; + FillChar(FDGAAddr^, FDGALineWidth * FDGAHeight * (FFormat.Bits Div 8), 0); + + XSelectInput(FDisplay, DefaultRootWindow(FDisplay), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + If FFormat.Bits = 8 Then + Begin + FColours := GetMem(256 * SizeOf(TXColor)); + If FColours = Nil Then + Raise TPTCError.Create('Cannot allocate colour map cells'); + FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen), + DefaultVisual(FDisplay, FScreen), AllocAll); + If FCMap = 0 Then + Raise TPTCError.Create('Cannot create colour map'); + End + Else + FCMap := 0; + + { Set 332 palette, for now } + If (FFormat.Bits = 8) And FFormat.Direct Then + Begin + {Taken from PTC 0.72, i hope it's fine} + For i := 0 To 255 Do + Begin + r := ((i And $E0) Shr 5) * 255 / 7; + g := ((i And $1C) Shr 2) * 255 / 7; + b := (i And $03) * 255 / 3; + + FColours[i].pixel := i; + + FColours[i].red := Round(r) Shl 8; + FColours[i].green := Round(g) Shl 8; + FColours[i].blue := Round(b) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat); + +Begin + If AWindow = 0 Then; { Prevent warnings } + If AFormat = Nil Then; +End; + +Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); + +Begin + If (AWindow = 0) Or + (AFormat = Nil) Or + (AX = 0) Or + (AY = 0) Or + (AWidth = 0) Or + (AHeight = 0) Then; +End; + +Procedure TX11DGA1Display.Close; + +Begin + If FInDirect Then + Begin + FInDirect := False; + XF86DGADirectVideo(FDisplay, FScreen, 0); + End; + + If FInMode Then + Begin + FInMode := False; + XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[FPreviousMode]); + XUngrabKeyboard(FDisplay, CurrentTime); + XUngrabPointer(FDisplay, CurrentTime); + End; + + If FDisplay <> Nil Then + XFlush(FDisplay); + + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + FreeMemAndNil(FColours); + + If FModeInfo <> Nil Then + Begin + XFree(FModeInfo); + FModeInfo := Nil; + End; +End; + +Procedure TX11DGA1Display.GetModes(Var AModes : TPTCModeDynArray); + +Begin + SetLength(AModes, 1); + AModes[0] := TPTCMode.Create; + {todo...} +End; + +Procedure TX11DGA1Display.Update; + +Begin +End; + +Procedure TX11DGA1Display.Update(Const AArea : TPTCArea); + +Begin +End; + +Procedure TX11DGA1Display.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + End; + +Begin + NewFocusSpecified := False; + While UsefulEventsPending Do + Begin + XNextEvent(FDisplay, @e); + Case e._type Of + FocusIn : Begin + NewFocus := True; + NewFocusSpecified := True; + End; + FocusOut : Begin + NewFocus := False; + NewFocusSpecified := True; + End; + ClientMessage : Begin +{ If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGA1Display.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(AEvent); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + AEvent := FEventQueue.NextEvent(AEventMask); + + If AWait And (AEvent = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not AWait) Or (AEvent <> Nil); + Result := AEvent <> Nil; +End; + +Function TX11DGA1Display.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Var + tmpEvent : TXEvent; + +Begin + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(AEventMask); + + If AWait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not AWait) Or (Result <> Nil); +End; + + +Function TX11DGA1Display.Lock : Pointer; + +Begin + Result := FDGAAddr + FDGALineWidth * FDestY * (FFormat.Bits Div 8) + + FDestX * (FFormat.Bits Div 8); +End; + +Procedure TX11DGA1Display.Unlock; + +Begin +End; + +Procedure TX11DGA1Display.Palette(Const APalette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := APalette.data; + If Not FFormat.Indexed Then + Exit; + For i := 0 To 255 Do + Begin + FColours[i].pixel := i; + + FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; + FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; + FColours[i].blue := (pal[i] And $FF) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); +End; + +Function TX11DGA1Display.GetPitch : Integer; + +Begin + Result := FDGALineWidth * (FFormat.Bits Div 8); +End; + +Function TX11DGA1Display.GetX11Window : TWindow; + +Begin + Result := DefaultRootWindow(FDisplay); +End; + +Function TX11DGA1Display.IsFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGA1Display.SetCursor(AVisible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1} diff --git a/packages/ptc/src/x11/x11dga2displayd.inc b/packages/ptc/src/x11/x11dga2displayd.inc new file mode 100644 index 0000000000..7acb24f365 --- /dev/null +++ b/packages/ptc/src/x11/x11dga2displayd.inc @@ -0,0 +1,44 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + +Type + TX11DGA2Display = Class(TX11Display) + Private + Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + { The list of available modes (todo: move to local vars in the open function) } + FXDGAModes : PXDGAMode; + FXDGAModesNum : cint; + + { Holds the pointer to the framebuffer and all the other information for + the current mode (or nil, if a mode isn't open) } + FXDGADevice : PXDGADevice; + + { Coordinates of upper left frame corner } + m_destx, m_desty : Integer; + + FModeIsSet : Boolean; + FFramebufferIsOpen : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat); Override; + Procedure open(w : TWindow; Const _format : TPTCFormat); Override; + Procedure open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override; + Procedure close; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function getX11Window : TWindow; Override; + Function isFullScreen : Boolean; Override; + Procedure SetCursor(visible : Boolean); Override; + End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} diff --git a/packages/ptc/src/x11/x11dga2displayi.inc b/packages/ptc/src/x11/x11dga2displayi.inc new file mode 100644 index 0000000000..c73236eb39 --- /dev/null +++ b/packages/ptc/src/x11/x11dga2displayi.inc @@ -0,0 +1,451 @@ +{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2} + +Constructor TX11DGA2Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Var + dummy1, dummy2 : cint; + +Begin + Inherited; + + LOG('trying to open a DGA 2.0 display'); + + { Check if the DGA extension can be used } + LOG('checking if the DGA extension can be used (XDGAQueryExtension)'); + If Not XDGAQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); +End; + +Destructor TX11DGA2Display.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11DGA2Display.open(title : String; _width, _height : Integer; Const _format : TPTCFormat); + +Var + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + found : Boolean; + root : TWindow; + e : TXEvent; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + FWidth := _width; + FHeight := _height; + + LOG('trying to open framebuffer (XDGAOpenFramebuffer)'); + If Not XDGAOpenFramebuffer(FDisplay, FScreen) Then + Raise TPTCError.Create('Cannot open framebuffer - insufficient privileges?'); + FFramebufferIsOpen := True; + + { Get all availabe video modes } + LOG('querying available display modes (XDGAQueryModes)'); + FXDGAModes := XDGAQueryModes(FDisplay, FScreen, @FXDGAModesNum); + + LOG('number of display modes', FXDGAModesNum); + + For I := 0 To FXDGAModesNum - 1 Do + Begin + LOG('mode#', I); + LOG('num', FXDGAModes[I].num); + LOG('name: ' + FXDGAModes[I].name); + End; + + found_mode := 0; // todo: find a video mode + + Raise TPTCError.Create('break! dga 2.0 code unfinished'); + + FXDGADevice := XDGASetMode(FDisplay, FScreen, found_mode); + If FXDGADevice = Nil Then + Raise TPTCError.Create('XDGASetMode failed (returned nil)'); + If FXDGADevice^.data = Nil Then + Raise TPTCError.Create('The pointer to the framebuffer, returned by XDGA is nil?!'); + FModeIsSet := True; + + { Check if the requested colour mode is available } + FFormat := GetX11Format(_format); + + { Grab exclusive control over the keyboard and mouse } +{ root := XRootWindow(FDisplay, FScreen); + XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime);} + XFlush(FDisplay); + + { Get Display information } +{ XF86DGAGetVideo(FDisplay, FScreen, @dga_addr, @dga_linewidth, + @dga_banksize, @dga_memsize);} + + { Don't have to be root anymore } +{ setuid(getuid);...} + +// XF86DGAGetViewPortSize(FDisplay, FScreen, @dga_width, @dga_height); + +{ If XF86DGAForkApp(FScreen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork') + Else + Begin + If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + End;} + +// m_indirect := True; +// FillChar(dga_addr^, dga_linewidth * dga_height * (FFormat.bits Div 8), 0); + + XSelectInput(FDisplay, DefaultRootWindow(FDisplay), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + If FFormat.bits = 8 Then + Begin + FColours := GetMem(256 * SizeOf(TXColor)); + If FColours = Nil Then + Raise TPTCError.Create('Cannot allocate colour map cells'); + FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen), + DefaultVisual(FDisplay, FScreen), AllocAll); + If FCMap = 0 Then + Raise TPTCError.Create('Cannot create colour map'); + End + Else + FCMap := 0; + + { Set 332 palette, for now } + If (FFormat.bits = 8) And FFormat.direct Then + Begin + {Taken from PTC 0.72, i hope it's fine} + For i := 0 To 255 Do + Begin + r := ((i And $E0) Shr 5) * 255 / 7; + g := ((i And $1C) Shr 2) * 255 / 7; + b := (i And $03) * 255 / 3; + + FColours[i].pixel := i; + + FColours[i].red := Round(r) Shl 8; + FColours[i].green := Round(g) Shl 8; + FColours[i].blue := Round(b) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGA2Display.open(w : TWindow; Const _format : TPTCFormat); + +Begin + If w = 0 Then; { Prevent warnings } + If _format = Nil Then; +End; + +Procedure TX11DGA2Display.open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); + +Begin + If (_window = 0) Or (_format = Nil) Or (x = 0) Or + (y = 0) Or (w = 0) Or (h = 0) Then; +End; + +Procedure TX11DGA2Display.close; + +Var + tmp : Pointer; + +Begin + If FModeIsSet Then + Begin + FModeIsSet := False; + + { restore the original mode } + XDGASetMode(FDisplay, FScreen, 0); { returns PXDGADevice } +{ XUngrabKeyboard(FDisplay, CurrentTime); + XUngrabPointer(FDisplay, CurrentTime);} + End; + + If FFramebufferIsOpen Then + Begin + FFramebufferIsOpen := False; + XDGACloseFramebuffer(FDisplay, FScreen); + End; + + If FDisplay <> Nil Then + XFlush(FDisplay); + + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + FreeMemAndNil(FColours); + + If FXDGADevice <> Nil Then + Begin + tmp := FXDGADevice; + FXDGADevice := Nil; + XFree(tmp); + End; + + If FXDGAModes <> Nil Then + Begin + tmp := FXDGAModes; + FXDGAModes := Nil; + XFree(tmp); + End; +End; + +Procedure TX11DGA2Display.GetModes(Var AModes : TPTCModeDynArray); + +Begin + SetLength(AModes, 1); + AModes[0] := TPTCMode.Create; + {todo...} +End; + +Procedure TX11DGA2Display.update; + +Begin +End; + +Procedure TX11DGA2Display.update(Const _area : TPTCArea); + +Begin +End; + +Procedure TX11DGA2Display.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + End; + +Begin + NewFocusSpecified := False; + While UsefulEventsPending Do + Begin + XNextEvent(FDisplay, @e); + Case e._type Of + FocusIn : Begin + NewFocus := True; + NewFocusSpecified := True; + End; + FocusOut : Begin + NewFocus := False; + NewFocusSpecified := True; + End; + ClientMessage : Begin +{ If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGA2Display.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(event); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + event := FEventQueue.NextEvent(EventMask); + + If wait And (event = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not Wait) Or (event <> Nil); + Result := event <> Nil; +End; + +Function TX11DGA2Display.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; + +Var + tmpEvent : TXEvent; + +Begin + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(EventMask); + + If wait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not Wait) Or (Result <> Nil); +End; + + +Function TX11DGA2Display.lock : Pointer; + +Begin + lock := PByte(FXDGADevice^.data) + + FXDGADevice^.mode.bytesPerScanline * m_desty + + m_destx * (FXDGADevice^.mode.bitsPerPixel Div 8); +End; + +Procedure TX11DGA2Display.unlock; + +Begin +End; + +Procedure TX11DGA2Display.palette(Const _palette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := _palette.data; + If Not FFormat.indexed Then + Exit; + For i := 0 To 255 Do + Begin + FColours[i].pixel := i; + + FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; + FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; + FColours[i].blue := (pal[i] And $FF) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); + XF86DGAInstallColormap(FDisplay, FScreen, FCMap); +End; + +Function TX11DGA2Display.GetPitch : Integer; + +Begin + Result := FXDGADevice^.mode.bytesPerScanline; +End; + +Function TX11DGA2Display.getX11Window : TWindow; + +Begin + Result := DefaultRootWindow(FDisplay); +End; + +Function TX11DGA2Display.isFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGA2Display.SetCursor(visible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; + +{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2} diff --git a/packages/ptc/src/x11/x11dgadisplayd.inc b/packages/ptc/src/x11/x11dgadisplayd.inc new file mode 100644 index 0000000000..c46ee8092f --- /dev/null +++ b/packages/ptc/src/x11/x11dgadisplayd.inc @@ -0,0 +1,40 @@ +Type + TX11DGADisplay = Class(TX11Display) + Private + Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure HandleEvents; + + modeinfo : PPXF86VidModeModeInfo; + num_modeinfo : Integer; + previousmode : Integer; + + dga_addr : PByte; + dga_linewidth : Integer; + dga_banksize : Integer; + dga_memsize : Integer; + dga_width, dga_height : Integer; + + { Coordinates of upper left frame corner } + m_destx, m_desty : Integer; + + m_indirect, m_inmode : Boolean; + Public + Constructor Create; + Destructor Destroy; Override; + + Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Override; + Procedure open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); Override; + Procedure open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override; + Procedure close; Override; + Procedure update; Override; + Procedure update(Const _area : TPTCArea); Override; + Function lock : Pointer; Override; + Procedure unlock; Override; + Procedure palette(Const _palette : TPTCPalette); Override; + Function pitch : Integer; Override; + Function getX11Window : TWindow; Override; + Function isFullScreen : Boolean; Override; + Procedure SetCursor(visible : Boolean); Override; + End; diff --git a/packages/ptc/src/x11/x11dgadisplayi.inc b/packages/ptc/src/x11/x11dgadisplayi.inc new file mode 100644 index 0000000000..ec3cce862d --- /dev/null +++ b/packages/ptc/src/x11/x11dgadisplayi.inc @@ -0,0 +1,528 @@ +Constructor TX11DGADisplay.Create; + +Begin + m_indirect := False; + m_inmode := False; + modeinfo := Nil; + Inherited Create; + +// dga_LoadLibrary; + +{ If (XF86DGAQueryExtension = Nil) Or (XF86DGAGetVideo = Nil) Or + (XF86DGAGetViewPortSize = Nil) Or (XF86DGAForkApp = Nil) Or + (XF86DGADirectVideo = Nil) Or (XF86DGASetViewPort = Nil) Or + (XF86DGAInstallColormap = Nil) Then + Raise TPTCError.Create('DGA extension not available');} +End; + +Destructor TX11DGADisplay.Destroy; + +Begin + close; {fix close!} +// dga_UnloadLibrary; + Inherited Destroy; +End; + +Procedure TX11DGADisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); + +Var + dummy1, dummy2 : Integer; + vml : PXF86VidModeModeLine; + dotclock : Integer; + i : Integer; + found : Boolean; + root : TWindow; + e : TXEvent; + tmpArea : TPTCArea; + r, g, b : Single; + found_mode : Integer; + min_diff : Integer; + d_x, d_y : Integer; + +Begin + m_disp := disp; + m_screen := screen; + m_width := _width; + m_height := _height; + + { Check if we are root } + If fpgeteuid <> 0 Then + Raise TPTCError.Create('Have to be root to switch to DGA mode'); + + { Check if the DGA extension and VidMode extension can be used } + If Not XF86DGAQueryExtension(disp, @dummy1, @dummy2) Then + Raise TPTCError.Create('DGA extension not available'); + If Not XF86VidModeQueryExtension(disp, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); + + { Get all availabe video modes } + XF86VidModeGetAllModeLines(m_disp, m_screen, @num_modeinfo, @modeinfo); + + previousmode := -1; + { Save previous mode } + New(vml); + Try + XF86VidModeGetModeLine(m_disp, m_screen, @dotclock, vml); + Try + For i := 0 To num_modeinfo - 1 Do + Begin + If (vml^.hdisplay = modeinfo[i]^.hdisplay) And + (vml^.vdisplay = modeinfo[i]^.vdisplay) Then + Begin + previousmode := i; + Break; + End; + End; + Finally + If vml^.privsize <> 0 Then + XFree(vml^.c_private); + End; + Finally + Dispose(vml); + End; + If previousmode = -1 Then + Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)'); + + { Find a video mode to set } + + { Normal modesetting first, find exactly matching mode } + If Not (PTC_X11_PEDANTIC_DGA In m_flags) Then + Begin + found := False; + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay = _width) And (modeinfo[i]^.vdisplay = _height) Then + Begin + If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[i]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + m_destx := 0; + m_desty := 0; + found := True; + Break; + End; + End; + If Not found Then + Raise TPTCError.Create('Cannot find matching DGA video mode'); + End + Else + Begin + found_mode := $FFFF; + + { Try to find a mode that matches the width first } + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay = _width) And + (modeinfo[i]^.vdisplay >= _height) Then + Begin + found_mode := i; + Break; + End; + End; + + { Next try to match the height } + If found_mode = $FFFF Then + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay >= _width) And + (modeinfo[i]^.vdisplay = _height) Then + Begin + found_mode := i; + Break; + End; + End; + + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + min_diff := 987654321; + + For i := 0 To num_modeinfo - 1 Do + Begin + If (modeinfo[i]^.hdisplay >= _width) And (modeinfo[i]^.vdisplay >= _height) Then + Begin + d_x := modeinfo[i]^.hdisplay - _width; + d_x *= d_x; + d_y := modeinfo[i]^.vdisplay - _height; + d_y *= d_y; + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := i; + End; + End; + End; + + If found_mode <> $FFFF Then + Begin + If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[found_mode]) Then + Raise TPTCError.Create('Error switching to requested video mode'); + m_destx := (modeinfo[found_mode]^.hdisplay Div 2) - (_width Div 2); + m_desty := (modeinfo[found_mode]^.vdisplay Div 2) - (_height Div 2); + End + Else + Raise TPTCError.Create('Cannot find a video mode to use'); + End; + XFlush(m_disp); + m_inmode := True; + + { Check if the requested colour mode is available } + m_format := getFormat(_format); + + { Grab exclusive control over the keyboard and mouse } + root := XRootWindow(m_disp, m_screen); + XGrabKeyboard(m_disp, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); + XGrabPointer(m_disp, root, True, PointerMotionMask Or ButtonPressMask Or + ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, + CurrentTime); + XFlush(m_disp); + + { Get Display information } + XF86DGAGetVideo(m_disp, m_screen, @dga_addr, @dga_linewidth, + @dga_banksize, @dga_memsize); + + { Don't have to be root anymore } +{ setuid(getuid);...} + + XF86DGAGetViewPortSize(m_disp, m_screen, @dga_width, @dga_height); + + If XF86DGAForkApp(m_screen) <> 0 Then + Raise TPTCError.Create('cannot do safety fork') + Else + Begin + If XF86DGADirectVideo(m_disp, m_screen, XF86DGADirectGraphics Or + XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then + Raise TPTCError.Create('cannot switch to DGA mode'); + End; + + m_indirect := True; + FillChar(dga_addr^, dga_linewidth * dga_height * (m_format.bits Div 8), 0); + + XSelectInput(m_disp, DefaultRootWindow(m_disp), + KeyPressMask Or KeyReleaseMask); + + XF86DGASetViewPort(m_disp, m_screen, 0, 0); { Important.. sort of =) } + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + { Create colour map in 8 bit mode } + If m_format.bits = 8 Then + Begin + m_colours := GetMem(256 * SizeOf(TXColor)); + If m_colours = Nil Then + Raise TPTCError.Create('Cannot allocate colour map cells'); + m_cmap := XCreateColormap(m_disp, RootWindow(m_disp, m_screen), + DefaultVisual(m_disp, m_screen), AllocAll); + If m_cmap = 0 Then + Raise TPTCError.Create('Cannot create colour map'); + End + Else + m_cmap := 0; + + { Set 332 palette, for now } + If (m_format.bits = 8) And m_format.direct Then + Begin + {Taken from PTC 0.72, i hope it's fine} + For i := 0 To 255 Do + Begin + r := ((i And $E0) Shr 5) * 255 / 7; + g := ((i And $1C) Shr 2) * 255 / 7; + b := (i And $03) * 255 / 3; + + m_colours[i].pixel := i; + + m_colours[i].red := Round(r) Shl 8; + m_colours[i].green := Round(g) Shl 8; + m_colours[i].blue := Round(b) Shl 8; + + Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(m_disp, m_cmap, m_colours, 256); + XF86DGAInstallColormap(m_disp, m_screen, m_cmap); + End; + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, m_width, m_height); + Try + m_clip.ASSign(tmpArea); + Finally + tmpArea.Free; + End; +End; + +{ Not in DGA mode } +Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); + +Begin + If disp = Nil Then; { Prevent warnings } + If screen = 0 Then; + If w = 0 Then; + If _format = Nil Then; +End; + +Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); + +Begin + If (disp = Nil) Or (screen = 0) Or (_window = 0) Or (_format = Nil) Or (x = 0) Or + (y = 0) Or (w = 0) Or (h = 0) Then; +End; + +Procedure TX11DGADisplay.close; + +Begin + If m_indirect Then + Begin + m_indirect := False; + XF86DGADirectVideo(m_disp, m_screen, 0); + End; + +// Writeln('lala1'); + If m_inmode Then + Begin + m_inmode := False; + XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[previousmode]); + XUngrabKeyboard(m_disp, CurrentTime); + XUngrabPointer(m_disp, CurrentTime); + End; + +// Writeln('lala2'); + If m_disp <> Nil Then + XFlush(m_disp); +// Writeln('lala3'); + + If m_cmap <> 0 Then + Begin + XFreeColormap(m_disp, m_cmap); + m_cmap := 0; + End; + +// Writeln('lala4'); + FreeMemAndNil(m_colours); + +// Writeln('lala5'); + If modeinfo <> Nil Then + Begin + XFree(modeinfo); + modeinfo := Nil; + End; +// Writeln('lala6'); +End; + +Procedure TX11DGADisplay.update; + +Begin +End; + +Procedure TX11DGADisplay.update(Const _area : TPTCArea); + +Begin +End; + +Procedure TX11DGADisplay.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(m_disp, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(m_disp, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(m_disp, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(m_disp, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + End; + +Begin + NewFocusSpecified := False; + While UsefulEventsPending Do + Begin + XNextEvent(m_disp, @e); + Case e._type Of + FocusIn : Begin + NewFocus := True; + NewFocusSpecified := True; + End; + FocusOut : Begin + NewFocus := False; + NewFocusSpecified := True; + End; + ClientMessage : Begin +{ If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then + Halt(0);} + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease : Begin + {...} + End; + MotionNotify : Begin + {...} + End; + End; + End; +// HandleChangeFocus(NewFocus); +End; + +Function TX11DGADisplay.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(event); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + event := FEventQueue.NextEvent(EventMask); + + If wait And (event = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(m_disp, @tmpEvent); + End; + Until (Not Wait) Or (event <> Nil); + Result := event <> Nil; +End; + +Function TX11DGADisplay.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; + +Var + tmpEvent : TXEvent; + +Begin + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(EventMask); + + If wait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(m_disp, @tmpEvent); + End; + Until (Not Wait) Or (Result <> Nil); +End; + + +Function TX11DGADisplay.lock : Pointer; + +Begin + lock := dga_addr + dga_linewidth * m_desty * (m_format.bits Div 8) + + m_destx * (m_format.bits Div 8); +End; + +Procedure TX11DGADisplay.unlock; + +Begin +End; + +Procedure TX11DGADisplay.palette(Const _palette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := _palette.data; + If Not m_format.indexed Then + Exit; + For i := 0 To 255 Do + Begin + m_colours[i].pixel := i; + + m_colours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; + m_colours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; + m_colours[i].blue := (pal[i] And $FF) Shl 8; + + Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(m_disp, m_cmap, m_colours, 256); + XF86DGAInstallColormap(m_disp, m_screen, m_cmap); +End; + +Function TX11DGADisplay.pitch : Integer; + +Begin + pitch := dga_linewidth * (m_format.bits Div 8); +End; + +Function TX11DGADisplay.getX11Window : TWindow; + +Begin + Result := DefaultRootWindow(m_disp); +End; + +Function TX11DGADisplay.isFullScreen : Boolean; + +Begin + { DGA is always fullscreen } + Result := True; +End; + +Procedure TX11DGADisplay.SetCursor(visible : Boolean); + +Begin + {nothing... raise exception if visible=true?} +End; diff --git a/packages/ptc/src/x11/x11displayd.inc b/packages/ptc/src/x11/x11displayd.inc new file mode 100644 index 0000000000..9848461d1a --- /dev/null +++ b/packages/ptc/src/x11/x11displayd.inc @@ -0,0 +1,129 @@ +Type + TX11FlagsEnum = (PTC_X11_FULLSCREEN, + PTC_X11_LEAVE_DISPLAY, + PTC_X11_LEAVE_WINDOW, + PTC_X11_TRY_DGA, + PTC_X11_TRY_XF86VIDMODE, + PTC_X11_TRY_XRANDR, + PTC_X11_TRY_XSHM, + PTC_X11_DITHER, + PTC_X11_FULLSCREEN_CURSOR_VISIBLE, + PTC_X11_WINDOWED_CURSOR_INVISIBLE); + TX11Flags = Set Of TX11FlagsEnum; + +Type + TX11Display = Class(TObject) + Protected + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Virtual; Abstract; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract; + + Function GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat; + + { initialise the keyboard mapping table } + Procedure SetKeyMapping; + + { Data access } + Function GetWidth : Integer; + Function GetHeight : Integer; + Function GetPitch : Integer; Virtual; Abstract; + Function GetFormat : TPTCFormat; + Function GetArea : TPTCArea; + + { Conversion object } + FCopy : TPTCCopy; + FClear : TPTCClear; + FPalette : TPTCPalette; + + FArea : TPTCArea; + FClip : TPTCArea; + + FEventQueue : TEventQueue; + + FFlags : TX11Flags; + FWidth, FHeight : DWord; + FFormat : TPTCFormat; + + FDisplay : PDisplay; + FScreen : Integer; + + FCMap : TColormap; + FColours : PXColor; + + FFunctionKeys : PInteger; + FNormalKeys : PInteger; + + {m_thread : pthread_t;} + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Virtual; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Virtual; Abstract; + + { This will always return a windowed console. The first version + fills the whole window, the second one has a custom size } + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Virtual; Abstract; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Virtual; Abstract; + + Procedure Close; Virtual; Abstract; + + Procedure Update; Virtual; Abstract; + Procedure Update(Const AArea : TPTCArea); Virtual; Abstract; + + Function Lock : Pointer; Virtual; Abstract; + Procedure Unlock; Virtual; Abstract; + + { load pixels to console } + Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual; + Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; + + { save console pixels } + Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual; + Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); Virtual; + + { clear surface } + Procedure Clear(Const AColor : TPTCColor); Virtual; + Procedure Clear(Const AColor : TPTCColor; Const AArea : TPTCArea); Virtual; + + { Console palette } + Procedure Palette(Const APalette : TPTCPalette); Virtual; Abstract; + Function Palette : TPTCPalette; Virtual; + + { console clip area } + Procedure Clip(Const AArea : TPTCArea); + + { cursor control } + Procedure SetCursor(AVisible : Boolean); Virtual; Abstract; + + { Data access } + Function Clip : TPTCArea; + + Function IsFullScreen : Boolean; Virtual; Abstract; + + { Set flags (only used internally now!) } + Procedure SetFlags(AFlags : TX11Flags); + + Procedure GetModes(Var AModes : TPTCModeDynArray); Virtual; Abstract; + + { X11 helper functions for your enjoyment } + + { return the display we are using } + Function GetX11Display : PDisplay; + + { return the screen we are using } + Function GetX11Screen : Integer; + + { return our window (0 if DGA) } + Function GetX11Window : TWindow; Virtual; Abstract; + + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + Property Pitch : Integer Read GetPitch; + Property Area : TPTCArea Read GetArea; + Property Format : TPTCFormat Read GetFormat; + End; diff --git a/packages/ptc/src/x11/x11displayi.inc b/packages/ptc/src/x11/x11displayi.inc new file mode 100644 index 0000000000..f01e0fc990 --- /dev/null +++ b/packages/ptc/src/x11/x11displayi.inc @@ -0,0 +1,376 @@ +{$INCLUDE xunikey.inc} + +Constructor TX11Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Begin + FFlags := AFlags; + + FDisplay := ADisplay; + FScreen := AScreen; + + FCopy := TPTCCopy.Create; + FClear := TPTCClear.Create; + FPalette := TPTCPalette.Create; + FClip := TPTCArea.Create; + FArea := TPTCArea.Create; + FFormat := TPTCFormat.Create; + FEventQueue := TEventQueue.Create; + + SetKeyMapping; +End; + +Destructor TX11Display.Destroy; + +Begin + { Just close the display, everything else is done by the subclasses } + If (FDisplay <> Nil) And (Not (PTC_X11_LEAVE_DISPLAY In FFlags)) Then + Begin + XFlush(FDisplay); + XCloseDisplay(FDisplay); + FDisplay := Nil; + End; + FreeMemAndNil(FNormalKeys); + FreeMemAndNil(FFunctionKeys); + + FCopy.Free; + FClear.Free; + FPalette.Free; + FClip.Free; + FArea.Free; + FFormat.Free; + FEventQueue.Free; + + Inherited Destroy; +End; + +Procedure TX11Display.Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); +Var + Area_ : TPTCArea; + console_pixels : Pointer; + +Begin + If Clip.Equals(Area) Then + Begin + Try + console_pixels := Lock; + Try + FCopy.Request(AFormat, Format); + FCopy.Palette(APalette, Palette); + FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0, + Width, Height, Pitch); + Finally + Unlock; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console', error); + End; + End + Else + Begin + Area_ := TPTCArea.Create(0, 0, width, height); + Try + Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area); + Finally + Area_.Free; + End; + End; +End; + +Procedure TX11Display.Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); +Var + console_pixels : Pointer; + clipped_source, clipped_destination : TPTCArea; + tmp : TPTCArea; + +Begin + clipped_source := Nil; + clipped_destination := Nil; + Try + console_pixels := Lock; + Try + clipped_source := TPTCArea.Create; + clipped_destination := TPTCArea.Create; + tmp := TPTCArea.Create(0, 0, AWidth, AHeight); + Try + TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination); + Finally + tmp.Free; + End; + FCopy.request(AFormat, Format); + FCopy.palette(APalette, Palette); + FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch, + console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch); + Finally + Unlock; + clipped_source.Free; + clipped_destination.Free; + End; + Except + On error : TPTCError Do + Raise TPTCError.Create('failed to load pixels to console area', error); + End; +End; + +Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette); + +Begin +End; + +Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer; + Const AFormat : TPTCFormat; Const APalette : TPTCPalette; + Const ASource, ADestination : TPTCArea); + +Begin +End; + +Procedure TX11Display.Clear(Const AColor : TPTCColor); + +Begin +End; + +Procedure TX11Display.Clear(Const AColor : TPTCColor; Const AArea : TPTCArea); + +Begin +End; + +Function TX11Display.Palette : TPTCPalette; + +Begin + Result := FPalette; +End; + +Procedure TX11Display.Clip(Const AArea : TPTCArea); + +Begin + FClip.Assign(AArea); +End; + +Function TX11Display.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11Display.GetHeight : Integer; + +Begin + Result := FHeight; +End; + +Function TX11Display.Clip : TPTCArea; + +Begin + Result := FClip; +End; + +Function TX11Display.GetArea : TPTCArea; + +Var + tmp : TPTCArea; + +Begin + tmp := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FArea.Assign(tmp); + Finally + tmp.Free; + End; + Result := FArea; +End; + +Function TX11Display.GetFormat : TPTCFormat; + +Begin + Result := FFormat; +End; + +Procedure TX11Display.SetFlags(AFlags : TX11Flags); + +Begin + FFlags := AFlags; +End; + +Function TX11Display.GetX11Display : PDisplay; + +Begin + Result := FDisplay; +End; + +Function TX11Display.GetX11Screen : Integer; + +Begin + Result := FScreen; +End; + +Function TX11Display.GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat; + +Var + tmp_depth : Integer; + numfound : Integer; + i : Integer; + pfv : PXPixmapFormatValues; + +Begin + Result := Nil; + + { Check if our screen has the same format available. I hate how X } + { keeps bits_per_pixel and depth different } + tmp_depth := DisplayPlanes(FDisplay, FScreen); + + pfv := XListPixmapFormats(FDisplay, @numfound); + Try + For i := 0 To numfound - 1 Do + Begin + If pfv[i].depth = tmp_depth Then + Begin + tmp_depth := pfv[i].bits_per_pixel; + Break; + End; + End; + Finally + XFree(pfv); + End; + + If (tmp_depth = 8) And AFormat.Indexed Then + Result := TPTCFormat.Create(8) + Else + If (tmp_depth = 8) And AFormat.Direct Then + Result := TPTCFormat.Create(8, $E0, $1C, $03) + Else + Result := TPTCFormat.Create(tmp_depth, + DefaultVisual(FDisplay, FScreen)^.red_mask, + DefaultVisual(FDisplay, FScreen)^.green_mask, + DefaultVisual(FDisplay, FScreen)^.blue_mask); +End; + +Procedure TX11Display.SetKeyMapping; + +Var + _I : Integer; + +Begin + FreeMemAndNil(FFunctionKeys); + FreeMemAndNil(FNormalKeys); + FFunctionKeys := GetMem(256 * SizeOf(Integer)); + FNormalKeys := GetMem(256 * SizeOf(Integer)); + + For _I := 0 To 255 Do + Begin + FFunctionKeys[_I] := Integer(PTCKEY_UNDEFINED); + FNormalKeys[_I] := Integer(PTCKEY_UNDEFINED); + End; + + { Assign function key indices from X definitions } + FFunctionKeys[$FF And XK_BackSpace] := Integer(PTCKEY_BACKSPACE); + FFunctionKeys[$FF And XK_Tab] := Integer(PTCKEY_TAB); + FFunctionKeys[$FF And XK_Clear] := Integer(PTCKEY_CLEAR); + FFunctionKeys[$FF And XK_Return] := Integer(PTCKEY_ENTER); + FFunctionKeys[$FF And XK_Pause] := Integer(PTCKEY_PAUSE); + FFunctionKeys[$FF And XK_Scroll_Lock] := Integer(PTCKEY_SCROLLLOCK); + FFunctionKeys[$FF And XK_Escape] := Integer(PTCKEY_ESCAPE); + FFunctionKeys[$FF And XK_Delete] := Integer(PTCKEY_DELETE); + + FFunctionKeys[$FF And XK_Kanji] := Integer(PTCKEY_KANJI); + + FFunctionKeys[$FF And XK_Home] := Integer(PTCKEY_HOME); + FFunctionKeys[$FF And XK_Left] := Integer(PTCKEY_LEFT); + FFunctionKeys[$FF And XK_Up] := Integer(PTCKEY_UP); + FFunctionKeys[$FF And XK_Right] := Integer(PTCKEY_RIGHT); + FFunctionKeys[$FF And XK_Down] := Integer(PTCKEY_DOWN); + FFunctionKeys[$FF And XK_Page_Up] := Integer(PTCKEY_PAGEUP); + FFunctionKeys[$FF And XK_Page_Down] := Integer(PTCKEY_PAGEDOWN); + FFunctionKeys[$FF And XK_End] := Integer(PTCKEY_END); + + FFunctionKeys[$FF And XK_Print] := Integer(PTCKEY_PRINTSCREEN); + FFunctionKeys[$FF And XK_Insert] := Integer(PTCKEY_INSERT); + FFunctionKeys[$FF And XK_Num_Lock] := Integer(PTCKEY_NUMLOCK); + + FFunctionKeys[$FF And XK_KP_0] := Integer(PTCKEY_NUMPAD0); + FFunctionKeys[$FF And XK_KP_1] := Integer(PTCKEY_NUMPAD1); + FFunctionKeys[$FF And XK_KP_2] := Integer(PTCKEY_NUMPAD2); + FFunctionKeys[$FF And XK_KP_3] := Integer(PTCKEY_NUMPAD3); + FFunctionKeys[$FF And XK_KP_4] := Integer(PTCKEY_NUMPAD4); + FFunctionKeys[$FF And XK_KP_5] := Integer(PTCKEY_NUMPAD5); + FFunctionKeys[$FF And XK_KP_6] := Integer(PTCKEY_NUMPAD6); + FFunctionKeys[$FF And XK_KP_7] := Integer(PTCKEY_NUMPAD7); + FFunctionKeys[$FF And XK_KP_8] := Integer(PTCKEY_NUMPAD8); + FFunctionKeys[$FF And XK_KP_9] := Integer(PTCKEY_NUMPAD9); + + FFunctionKeys[$FF And XK_F1] := Integer(PTCKEY_F1); + FFunctionKeys[$FF And XK_F2] := Integer(PTCKEY_F2); + FFunctionKeys[$FF And XK_F3] := Integer(PTCKEY_F3); + FFunctionKeys[$FF And XK_F4] := Integer(PTCKEY_F4); + FFunctionKeys[$FF And XK_F5] := Integer(PTCKEY_F5); + FFunctionKeys[$FF And XK_F6] := Integer(PTCKEY_F6); + FFunctionKeys[$FF And XK_F7] := Integer(PTCKEY_F7); + FFunctionKeys[$FF And XK_F8] := Integer(PTCKEY_F8); + FFunctionKeys[$FF And XK_F9] := Integer(PTCKEY_F9); + FFunctionKeys[$FF And XK_F10] := Integer(PTCKEY_F10); + FFunctionKeys[$FF And XK_F11] := Integer(PTCKEY_F11); + FFunctionKeys[$FF And XK_F12] := Integer(PTCKEY_F12); + + FFunctionKeys[$FF And XK_Shift_L] := Integer(PTCKEY_SHIFT); + FFunctionKeys[$FF And XK_Shift_R] := Integer(PTCKEY_SHIFT); + FFunctionKeys[$FF And XK_Control_L] := Integer(PTCKEY_CONTROL); + FFunctionKeys[$FF And XK_Control_R] := Integer(PTCKEY_CONTROL); + FFunctionKeys[$FF And XK_Caps_Lock] := Integer(PTCKEY_CAPSLOCK); + FFunctionKeys[$FF And XK_Meta_L] := Integer(PTCKEY_META); + FFunctionKeys[$FF And XK_Meta_R] := Integer(PTCKEY_META); + FFunctionKeys[$FF And XK_Alt_L] := Integer(PTCKEY_ALT); + FFunctionKeys[$FF And XK_Alt_R] := Integer(PTCKEY_ALT); + + { Assign normal key indices } + FNormalKeys[$FF And XK_space] := Integer(PTCKEY_SPACE); + FNormalKeys[$FF And XK_comma] := Integer(PTCKEY_COMMA); + FNormalKeys[$FF And XK_minus] := Integer(PTCKEY_SUBTRACT); + FNormalKeys[$FF And XK_period] := Integer(PTCKEY_PERIOD); + FNormalKeys[$FF And XK_slash] := Integer(PTCKEY_SLASH); + FNormalKeys[$FF And XK_0] := Integer(PTCKEY_ZERO); + FNormalKeys[$FF And XK_1] := Integer(PTCKEY_ONE); + FNormalKeys[$FF And XK_2] := Integer(PTCKEY_TWO); + FNormalKeys[$FF And XK_3] := Integer(PTCKEY_THREE); + FNormalKeys[$FF And XK_4] := Integer(PTCKEY_FOUR); + FNormalKeys[$FF And XK_5] := Integer(PTCKEY_FIVE); + FNormalKeys[$FF And XK_6] := Integer(PTCKEY_SIX); + FNormalKeys[$FF And XK_7] := Integer(PTCKEY_SEVEN); + FNormalKeys[$FF And XK_8] := Integer(PTCKEY_EIGHT); + FNormalKeys[$FF And XK_9] := Integer(PTCKEY_NINE); + FNormalKeys[$FF And XK_semicolon] := Integer(PTCKEY_SEMICOLON); + FNormalKeys[$FF And XK_equal] := Integer(PTCKEY_EQUALS); + + FNormalKeys[$FF And XK_bracketleft] := Integer(PTCKEY_OPENBRACKET); + FNormalKeys[$FF And XK_backslash] := Integer(PTCKEY_BACKSLASH); + FNormalKeys[$FF And XK_bracketright] := Integer(PTCKEY_CLOSEBRACKET); + + FNormalKeys[$FF And XK_a] := Integer(PTCKEY_A); + FNormalKeys[$FF And XK_b] := Integer(PTCKEY_B); + FNormalKeys[$FF And XK_c] := Integer(PTCKEY_C); + FNormalKeys[$FF And XK_d] := Integer(PTCKEY_D); + FNormalKeys[$FF And XK_e] := Integer(PTCKEY_E); + FNormalKeys[$FF And XK_f] := Integer(PTCKEY_F); + FNormalKeys[$FF And XK_g] := Integer(PTCKEY_G); + FNormalKeys[$FF And XK_h] := Integer(PTCKEY_H); + FNormalKeys[$FF And XK_i] := Integer(PTCKEY_I); + FNormalKeys[$FF And XK_j] := Integer(PTCKEY_J); + FNormalKeys[$FF And XK_k] := Integer(PTCKEY_K); + FNormalKeys[$FF And XK_l] := Integer(PTCKEY_L); + FNormalKeys[$FF And XK_m] := Integer(PTCKEY_M); + FNormalKeys[$FF And XK_n] := Integer(PTCKEY_N); + FNormalKeys[$FF And XK_o] := Integer(PTCKEY_O); + FNormalKeys[$FF And XK_p] := Integer(PTCKEY_P); + FNormalKeys[$FF And XK_q] := Integer(PTCKEY_Q); + FNormalKeys[$FF And XK_r] := Integer(PTCKEY_R); + FNormalKeys[$FF And XK_s] := Integer(PTCKEY_S); + FNormalKeys[$FF And XK_t] := Integer(PTCKEY_T); + FNormalKeys[$FF And XK_u] := Integer(PTCKEY_U); + FNormalKeys[$FF And XK_v] := Integer(PTCKEY_V); + FNormalKeys[$FF And XK_w] := Integer(PTCKEY_W); + FNormalKeys[$FF And XK_x] := Integer(PTCKEY_X); + FNormalKeys[$FF And XK_y] := Integer(PTCKEY_Y); + FNormalKeys[$FF And XK_z] := Integer(PTCKEY_Z); +End; diff --git a/packages/ptc/src/x11/x11imaged.inc b/packages/ptc/src/x11/x11imaged.inc new file mode 100644 index 0000000000..3a5ee7268d --- /dev/null +++ b/packages/ptc/src/x11/x11imaged.inc @@ -0,0 +1,46 @@ +Type + TX11Image = Class(TObject) + Protected + FWidth, FHeight : Integer; + FDisplay : PDisplay; + FImage : PXImage; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Virtual; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Virtual; Abstract; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Virtual; Abstract; + Function Lock : Pointer; Virtual; Abstract; + Function Pitch : Integer; Virtual; Abstract; + Function Name : String; Virtual; Abstract; + End; + + TX11NormalImage = Class(TX11Image) + Private + FPixels : PUint8; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override; + Destructor Destroy; Override; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Override; + Function Lock : Pointer; Override; + Function Pitch : Integer; Override; + Function Name : String; Override; + End; + +{$IFDEF ENABLE_X11_EXTENSION_XSHM} + TX11ShmImage = Class(TX11Image) + Private + FShmInfo : TXShmSegmentInfo; + FShmAttached : Boolean; + Public + Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override; + Destructor Destroy; Override; + Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override; + Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); Override; + Function Lock : Pointer; Override; + Function Pitch : Integer; Override; + Function Name : String; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/x11imagei.inc b/packages/ptc/src/x11/x11imagei.inc new file mode 100644 index 0000000000..2050999de0 --- /dev/null +++ b/packages/ptc/src/x11/x11imagei.inc @@ -0,0 +1,197 @@ +Const +{$WARNING this belongs to the ipc unit} + IPC_PRIVATE = 0; + +Constructor TX11Image.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Begin + FWidth := AWidth; + FHeight := AHeight; + FDisplay := ADisplay; +End; + +Constructor TX11NormalImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Var + xpad, xpitch : Integer; + tmp_FPixels : PChar; + +Begin + Inherited; + + xpad := AFormat.Bits; + If AFormat.Bits = 24 Then + xpad := 32; + xpitch := AWidth * AFormat.Bits Div 8; + Inc(xpitch, 3); + xpitch := xpitch And (Not 3); + FPixels := GetMem(xpitch * AHeight); + Pointer(tmp_FPixels) := Pointer(FPixels); + FImage := XCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen), + DefaultDepth(ADisplay, AScreen), + ZPixmap, 0, tmp_FPixels, + AWidth, AHeight, xpad, 0); + If FImage = Nil Then + Raise TPTCError.Create('cannot create XImage'); +End; + +Destructor TX11NormalImage.Destroy; + +Begin + If FImage <> Nil Then + Begin + { Restore XImage's buffer pointer } + FImage^.data := Nil; + XDestroyImage(FImage); + End; + + If FPixels <> Nil Then + FreeMem(FPixels); + + Inherited Destroy; +End; + +Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); + +Begin + XPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight); + XSync(FDisplay, False); +End; + +Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); + +Begin + XPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, AWidth, AHeight); + XSync(FDisplay, False); +End; + +Function TX11NormalImage.Lock : Pointer; + +Begin + Result := FPixels; +End; + +Function TX11NormalImage.Pitch : Integer; + +Begin + Result := FImage^.bytes_per_line; +End; + +Function TX11NormalImage.Name : String; + +Begin + Result := 'XImage'; +End; + +{$IFDEF ENABLE_X11_EXTENSION_XSHM} + +Var + Fshm_error : Boolean; + Fshm_oldhandler : Function(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl; + +Function Fshm_errorhandler(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl; + +Begin + If xev^.error_code=BadAccess Then + Begin + Fshm_error := True; + Result := 0; + End + Else + Result := Fshm_oldhandler(disp, xev); +End; + +Constructor TX11ShmImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); + +Begin + Inherited; + + FShmInfo.shmid := -1; + FShmInfo.shmaddr := Pointer(-1); + FImage := XShmCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen), + DefaultDepth(ADisplay, AScreen), + ZPixmap, Nil, @FShmInfo, AWidth, AHeight); + If FImage = Nil Then + Raise TPTCError.Create('cannot create SHM image'); + + FShmInfo.shmid := shmget(IPC_PRIVATE, FImage^.bytes_per_line * FImage^.height, + IPC_CREAT Or &777); + If FShmInfo.shmid = -1 Then + Raise TPTCError.Create('cannot get shared memory segment'); + + FShmInfo.shmaddr := shmat(FShmInfo.shmid, Nil, 0); + FShmInfo.readOnly := False; + FImage^.data := FShmInfo.shmaddr; + + If Pointer(FShmInfo.shmaddr) = Pointer(-1) Then + Raise TPTCError.Create('cannot allocate shared memory'); + + // Try and attach the segment to the server. Bugfix: Have to catch + // bad access errors in case it runs over the net. + Fshm_error := False; + Fshm_oldhandler := XSetErrorHandler(@Fshm_errorhandler); + Try + If XShmAttach(ADisplay, @FShmInfo) = 0 Then + Raise TPTCError.Create('cannot attach shared memory segment to display'); + + XSync(ADisplay, False); + If Fshm_error Then + Raise TPTCError.Create('cannot attach shared memory segment to display'); + FShmAttached := True; + Finally + XSetErrorHandler(Fshm_oldhandler); + End; +End; + +Destructor TX11ShmImage.Destroy; + +Begin + If FShmAttached Then + Begin + XShmDetach(FDisplay, @FShmInfo); + XSync(FDisplay, False); + End; + If FImage <> Nil Then + XDestroyImage(FImage); + If Pointer(FShmInfo.shmaddr) <> Pointer(-1) Then + shmdt(FShmInfo.shmaddr); + If FShmInfo.shmid <> -1 Then + shmctl(FShmInfo.shmid, IPC_RMID, Nil); + + Inherited Destroy; +End; + +Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); + +Begin + XShmPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight, False); + XSync(FDisplay, False); +End; + +Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY, + AWidth, AHeight : Integer); + +Begin + XShmPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, FWidth, FHeight, False); + XSync(FDisplay, False); +End; + +Function TX11ShmImage.Lock : Pointer; + +Begin + Result := Pointer(FShmInfo.shmaddr); +End; + +Function TX11ShmImage.Pitch : Integer; + +Begin + Result := FImage^.bytes_per_line; +End; + +Function TX11ShmImage.Name : String; + +Begin + Result := 'MIT-Shm'; +End; +{$ENDIF ENABLE_X11_EXTENSION_XSHM} diff --git a/packages/ptc/src/x11/x11modesd.inc b/packages/ptc/src/x11/x11modesd.inc new file mode 100644 index 0000000000..39ff7f3c4a --- /dev/null +++ b/packages/ptc/src/x11/x11modesd.inc @@ -0,0 +1,69 @@ +Type + TX11Modes = Class(TObject) + Private + FDisplay : PDisplay; + FScreen : cint; + Protected + Function GetWidth : Integer; Virtual; Abstract; + Function GetHeight : Integer; Virtual; Abstract; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Virtual; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Virtual; Abstract; + Procedure SetBestMode(AWidth, AHeight : Integer); Virtual; Abstract; + Procedure RestorePreviousMode; Virtual; Abstract; + Property Width : Integer Read GetWidth; + Property Height : Integer Read GetHeight; + End; + + TX11ModesNoModeSwitching = Class(TX11Modes) + Private + FWidth, FHeight : Integer; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; + +{$IFDEF ENABLE_X11_EXTENSION_XRANDR} + TX11ModesXrandr = Class(TX11Modes) + Private + FRoot : TWindow; + FXRRConfig : PXRRScreenConfiguration; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Destructor Destroy; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XRANDR} + +{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} + TX11ModesXF86VidMode = Class(TX11Modes) + Private + FModeList : PPXF86VidModeModeInfo; + FModeListCount : cint; + FSavedMode : PXF86VidModeModeLine; + FSavedDotClock : cint; + FWidth, FHeight : Integer; + + Procedure RetrieveModeList; + Function FindNumberOfBestMode(AWidth, AHeight : Integer) : Integer; + Protected + Function GetWidth : Integer; Override; + Function GetHeight : Integer; Override; + Public + Constructor Create(ADisplay : PDisplay; AScreen : cint); Override; + Destructor Destroy; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override; + Procedure SetBestMode(AWidth, AHeight : Integer); Override; + Procedure RestorePreviousMode; Override; + End; +{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} diff --git a/packages/ptc/src/x11/x11modesi.inc b/packages/ptc/src/x11/x11modesi.inc new file mode 100644 index 0000000000..15846c0d7c --- /dev/null +++ b/packages/ptc/src/x11/x11modesi.inc @@ -0,0 +1,291 @@ +Constructor TX11Modes.Create(ADisplay : PDisplay; AScreen : cint); + +Begin + FDisplay := ADisplay; + FScreen := AScreen; +End; + +Constructor TX11ModesNoModeSwitching.Create(ADisplay : PDisplay; AScreen : cint); + +Begin + Inherited; + + FWidth := DisplayWidth(FDisplay, FScreen); + FHeight := DisplayHeight(FDisplay, FScreen); +End; + +Procedure TX11ModesNoModeSwitching.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Begin + SetLength(AModes, 2); + AModes[0] := TPTCMode.Create(FWidth, + FHeight, + ACurrentDesktopFormat); + AModes[1] := TPTCMode.Create; +End; + +Procedure TX11ModesNoModeSwitching.SetBestMode(AWidth, AHeight : Integer); + +Begin + FWidth := DisplayWidth(FDisplay, FScreen); + FHeight := DisplayHeight(FDisplay, FScreen); +End; + +Procedure TX11ModesNoModeSwitching.RestorePreviousMode; + +Begin + { do nothing } +End; + +Function TX11ModesNoModeSwitching.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11ModesNoModeSwitching.GetHeight : Integer; + +Begin + Result := FHeight; +End; + +{$IFDEF ENABLE_X11_EXTENSION_XRANDR} +Constructor TX11ModesXrandr.Create(ADisplay : PDisplay; AScreen : cint); + +Var + dummy1, dummy2 : cint; + Major, Minor : cint; + +Begin + Inherited; + + If Not XRRQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('Xrandr extension not available'); + + XRRQueryVersion(FDisplay, @Major, @Minor); // todo: check + LOG('Xrandr version: ' + IntToStr(Major) + '.' + IntToStr(Minor)); + + FRoot := RootWindow(FDisplay, FScreen); + + FXRRConfig := XRRGetScreenInfo(FDisplay, FRoot); + If FXRRConfig = Nil Then + Raise TPTCError.Create('XRRGetScreenInfo failed'); + + Raise TPTCError.Create('Xrandr mode switcher is not yet implemented...'); +End; + +Destructor TX11ModesXrandr.Destroy; + +Begin + If FXRRConfig <> Nil Then + XRRFreeScreenConfigInfo(FXRRConfig); + + Inherited; +End; + +Procedure TX11ModesXrandr.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Begin + {...} +End; + +Procedure TX11ModesXrandr.SetBestMode(AWidth, AHeight : Integer); + +Begin + {todo...} +End; + +Procedure TX11ModesXrandr.RestorePreviousMode; + +Begin + {todo...} +End; + +Function TX11ModesXrandr.GetWidth : Integer; + +Begin + // todo... +End; + +Function TX11ModesXrandr.GetHeight : Integer; + +Begin + // todo... +End; +{$ENDIF ENABLE_X11_EXTENSION_XRANDR} + +{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} +Constructor TX11ModesXF86VidMode.Create(ADisplay : PDisplay; AScreen : Integer); + +Var + dummy1, dummy2 : cint; + +Begin + Inherited; + + FSavedMode := Nil; + FSavedDotClock := 0; + FModeList := Nil; + FModeListCount := 0; + + If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then + Raise TPTCError.Create('VidMode extension not available'); +End; + +Destructor TX11ModesXF86VidMode.Destroy; + +Begin + If FSavedMode <> Nil Then + Begin + RestorePreviousMode; + If FSavedMode^.privsize <> 0 Then + XFree(FSavedMode^.c_private); + Dispose(FSavedMode); + End; + + If FModeList <> Nil Then + XFree(FModeList); + + Inherited Destroy; +End; + +{todo: move the saving of the previous mode to a separate function...} +Procedure TX11ModesXF86VidMode.RetrieveModeList; + +Begin + { If we have been called before, do nothing } + If FModeList <> Nil Then + Exit; + + { Save previous mode } + New(FSavedMode); + FillChar(FSavedMode^, SizeOf(FSavedMode^), 0); + XF86VidModeGetModeLine(FDisplay, FScreen, @FSavedDotClock, FSavedMode); + + { Get all available video modes } + XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeListCount, @FModeList); +End; + +Procedure TX11ModesXF86VidMode.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); + +Var + I : Integer; + +Begin + RetrieveModeList; + + SetLength(AModes, FModeListCount + 1); + AModes[FModeListCount] := TPTCMode.Create; + For I := 0 To FModeListCount - 1 Do + AModes[I] := TPTCMode.Create(FModeList[I]^.hdisplay, FModeList[I]^.vdisplay, ACurrentDesktopFormat); +End; + +Function TX11ModesXF86VidMode.FindNumberOfBestMode(AWidth, AHeight : Integer) : Integer; + +Var + min_diff : Integer; + d_x, d_y : Integer; + found_mode : Integer; + I : Integer; + +Begin + { Try an exact match } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay = AWidth) And (FModeList[I]^.vdisplay = AHeight) Then + Exit(I); + + { Try to find a mode that matches the width first } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay = AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then + Exit(I); + + { Next try to match the height } + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay >= AWidth) And (FModeList[I]^.vdisplay = AHeight) Then + Exit(I); + + { Finally, find the mode that is bigger than the requested one and makes } + { the least difference } + found_mode := -1; + min_diff := High(Integer); + For I := 0 To FModeListCount - 1 Do + If (FModeList[I]^.hdisplay >= AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then + Begin + d_x := Sqr(FModeList[I]^.hdisplay - AWidth); + d_y := Sqr(FModeList[I]^.vdisplay - AHeight); + If (d_x + d_y) < min_diff Then + Begin + min_diff := d_x + d_y; + found_mode := I; + End; + End; + + If found_mode <> -1 Then + Result := found_mode + Else + Raise TPTCError.Create('Cannot find matching video mode'); +End; + +Procedure TX11ModesXF86VidMode.SetBestMode(AWidth, AHeight : Integer); + +Var + BestMode : Integer; + +Begin + RetrieveModeList; + + BestMode := FindNumberOfBestMode(AWidth, AHeight); + If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeList[BestMode]) Then + Raise TPTCError.Create('Error switching to the requested video mode'); + + FWidth := FModeList[BestMode]^.hdisplay; + FHeight := FModeList[BestMode]^.vdisplay; + + XWarpPointer(FDisplay, None, RootWindow(FDisplay, FScreen), 0, 0, 0, 0, + FWidth Div 2, + FHeight Div 2); + + If Not XF86VidModeSetViewPort(FDisplay, FScreen, 0, 0) Then + Raise TPTCError.Create('Error moving the viewport to the upper-left corner'); +End; + +Procedure TX11ModesXF86VidMode.RestorePreviousMode; + +Var + ModeInfo : TXF86VidModeModeInfo; + +Begin + If FSavedMode <> Nil Then + Begin + {FSavedMode is a TXF86VidModeModeLine, but XF86VidModeSwitchToMode wants a + TXF86VidModeModeInfo :} + FillChar(ModeInfo, SizeOf(ModeInfo), 0); + ModeInfo.dotclock := FSavedDotClock; + ModeInfo.hdisplay := FSavedMode^.hdisplay; + ModeInfo.hsyncstart := FSavedMode^.hsyncstart; + ModeInfo.hsyncend := FSavedMode^.hsyncend; + ModeInfo.htotal := FSavedMode^.htotal; + ModeInfo.vdisplay := FSavedMode^.vdisplay; + ModeInfo.vsyncstart := FSavedMode^.vsyncstart; + ModeInfo.vsyncend := FSavedMode^.vsyncend; + ModeInfo.vtotal := FSavedMode^.vtotal; + ModeInfo.flags := FSavedMode^.flags; + ModeInfo.privsize := FSavedMode^.privsize; + ModeInfo.c_private := FSavedMode^.c_private; + + XF86VidModeSwitchToMode(FDisplay, FScreen, @ModeInfo); + End; +End; + +Function TX11ModesXF86VidMode.GetWidth : Integer; + +Begin + Result := FWidth; +End; + +Function TX11ModesXF86VidMode.GetHeight : Integer; + +Begin + Result := FHeight; +End; +{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} diff --git a/packages/ptc/src/x11/x11windowdisplayd.inc b/packages/ptc/src/x11/x11windowdisplayd.inc new file mode 100644 index 0000000000..b065d7bd0b --- /dev/null +++ b/packages/ptc/src/x11/x11windowdisplayd.inc @@ -0,0 +1,52 @@ +Type + TX11WindowDisplay = Class(TX11Display) + Private + Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override; + Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override; + + Procedure EnterFullScreen; + Procedure LeaveFullScreen; + Procedure internal_ShowCursor(AVisible : Boolean); + Procedure HandleChangeFocus(ANewFocus : Boolean); + Procedure HandleEvents; + Function CreateImage(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; + AFormat : TPTCFormat) : TX11Image; { Factory method } + Function CreateModeSwitcher : TX11Modes; { Factory method } + Procedure CreateColormap; { Register colour maps } + {eventHandler} + FWindow : TWindow; + FPrimary : TX11Image; + FDestX, FDestY : Integer; + FGC : TGC; + FAtomClose : TAtom; { X Atom for close window button } + FCursorVisible : Boolean; + FX11InvisibleCursor : TCursor; { Blank cursor } + FFullScreen : Boolean; { Keeps a snapshot of the PTC_X11_FULLSCREEN option + taken at the time 'open' was called } + FFocus : Boolean; + FModeSwitcher : TX11Modes; + + FPreviousMouseButtonState : TPTCMouseButtonState; + FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas } + FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX, + FPreviousMouseY and FPreviousMouseButtonState contain valid values } + Public + Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override; + Destructor Destroy; Override; + + Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Override; + Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Override; + Procedure Close; Override; + Procedure Update; Override; + Procedure Update(Const AArea : TPTCArea); Override; + Function Lock : Pointer; Override; + Procedure Unlock; Override; + Procedure GetModes(Var AModes : TPTCModeDynArray); Override; + Procedure Palette(Const APalette : TPTCPalette); Override; + Function GetPitch : Integer; Override; + Function GetX11Window : TWindow; Override; + Function GetX11GC : TGC; Virtual; + Function IsFullScreen : Boolean; Override; + Procedure SetCursor(AVisible : Boolean); Override; + End; diff --git a/packages/ptc/src/x11/x11windowdisplayi.inc b/packages/ptc/src/x11/x11windowdisplayi.inc new file mode 100644 index 0000000000..f6841db41c --- /dev/null +++ b/packages/ptc/src/x11/x11windowdisplayi.inc @@ -0,0 +1,738 @@ +Constructor TX11WindowDisplay.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); + +Begin + Inherited; + FFocus := True; + FX11InvisibleCursor := None; + FCursorVisible := True; +End; + +Destructor TX11WindowDisplay.Destroy; + +Begin + Close; + Inherited Destroy; +End; + +Procedure TX11WindowDisplay.Open(ATitle : AnsiString; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); + +Var + tmpFormat : TPTCFormat; + xgcv : TXGCValues; + textprop : TXTextProperty; + e : TXEvent; + found : Boolean; + attr : TXSetWindowAttributes; + size_hints : PXSizeHints; + tmpArea : TPTCArea; + tmppchar : PChar; + tmpArrayOfCLong : Array[1..1] Of clong; + tmpPixmap : TPixmap; + BlackColor : TXColor; + BlankCursorData : Array[1..8] Of Byte = (0, 0, 0, 0, 0, 0, 0, 0); + +Begin + FHeight := AHeight; + FWidth := AWidth; + FDestX := 0; + FDestY := 0; + + FFullScreen := PTC_X11_FULLSCREEN In FFlags; + + FFocus := True; + + FPreviousMousePositionSaved := False; + + FillChar(BlackColor, SizeOf(BlackColor), 0); + BlackColor.red := 0; + BlackColor.green := 0; + BlackColor.blue := 0; + + { Create the mode switcher object } + If (FModeSwitcher = Nil) And FFullScreen Then + FModeSwitcher := CreateModeSwitcher; + + { Create the invisible cursor } + tmpPixmap := XCreateBitmapFromData(FDisplay, RootWindow(FDisplay, FScreen), @BlankCursorData, 8, 8); + Try + FX11InvisibleCursor := XCreatePixmapCursor(FDisplay, tmpPixmap, tmpPixmap, @BlackColor, @BlackColor, 0, 0); + Finally + If tmpPixmap <> None Then + XFreePixmap(FDisplay, tmpPixmap); + End; + + { Check if we have that colour depth available.. Easy as there is no + format conversion yet } + tmpFormat := Nil; + Try + tmpFormat := GetX11Format(AFormat); + FFormat.Assign(tmpFormat); + Finally + tmpFormat.Free; + End; + tmpFormat := Nil; + + { Create a window } + FWindow := XCreateSimpleWindow(FDisplay, RootWindow(FDisplay, FScreen), 0, 0, + AWidth, AHeight, 0, BlackPixel(FDisplay, FScreen), + BlackPixel(FDisplay, FScreen)); + { Register the delete atom } + FAtomClose := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', False); + X11Check(XSetWMProtocols(FDisplay, FWindow, @FAtomClose, 1), 'XSetWMProtocols'); + { Get graphics context } + xgcv.graphics_exposures := False; + FGC := XCreateGC(FDisplay, FWindow, GCGraphicsExposures, @xgcv); + If FGC = Nil Then + Raise TPTCError.Create('can''t create graphics context'); + { Set window title } + tmppchar := PChar(ATitle); + X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty'); + Try + XSetWMName(FDisplay, FWindow, @textprop); + XFlush(FDisplay); + Finally + XFree(textprop.value); + End; + + { Set normal hints } + size_hints := XAllocSizeHints; + Try + size_hints^.flags := PMinSize Or PBaseSize; + size_hints^.min_width := AWidth; + size_hints^.min_height := AHeight; + size_hints^.base_width := AWidth; + size_hints^.base_height := AHeight; + If FFullScreen Then + Begin + size_hints^.flags := size_hints^.flags Or PWinGravity; + size_hints^.win_gravity := StaticGravity; + End + Else + Begin + { not fullscreen - add maxsize limit=minsize, i.e. make window not resizable } + size_hints^.flags := size_hints^.flags Or PMaxSize; + size_hints^.max_width := AWidth; + size_hints^.max_height := AHeight; + End; + XSetWMNormalHints(FDisplay, FWindow, size_hints); + XFlush(FDisplay); + Finally + XFree(size_hints); + End; + + { Set the _NET_WM_STATE property } + If FFullScreen Then + Begin + tmpArrayOfCLong[1] := XInternAtom(FDisplay, '_NET_WM_STATE_FULLSCREEN', False); + + XChangeProperty(FDisplay, FWindow, + XInternAtom(FDisplay, '_NET_WM_STATE', False), + XA_ATOM, + 32, PropModeReplace, @tmpArrayOfCLong, 1); + End; + + { Map the window and wait for success } + XSelectInput(FDisplay, FWindow, StructureNotifyMask); + XMapRaised(FDisplay, FWindow); + Repeat + XNextEvent(FDisplay, @e); + If e._type = MapNotify Then + Break; + Until False; + { Get keyboard input and sync } + XSelectInput(FDisplay, FWindow, KeyPressMask Or KeyReleaseMask Or + StructureNotifyMask Or FocusChangeMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask); + XSync(FDisplay, False); + { Create XImage using factory method } + FPrimary := CreateImage(FDisplay, FScreen, FWidth, FHeight, FFormat); + + found := False; + Repeat + { Stupid loop. The key } + { events were causing } + { problems.. } + found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); + Until Not found; + + attr.backing_store := Always; + XChangeWindowAttributes(FDisplay, FWindow, CWBackingStore, @attr); + + { Set clipping area } + tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + FClip.Assign(tmpArea); + Finally + tmpArea.Free; + End; + + { Installs the right colour map for 8 bit modes } + CreateColormap; + + If FFullScreen Then + EnterFullScreen; +End; + +Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat); + +Begin +End; + +Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); + +Begin +End; + +Procedure TX11WindowDisplay.Close; + +Begin + FreeAndNil(FModeSwitcher); + + {pthreads?!} + If FCMap <> 0 Then + Begin + XFreeColormap(FDisplay, FCMap); + FCMap := 0; + End; + + { Destroy XImage and buffer } + FreeAndNil(FPrimary); + FreeMemAndNil(FColours); + + { Hide and destroy window } + If (FWindow <> 0) And (Not (PTC_X11_LEAVE_WINDOW In FFlags)) Then + Begin + XUnmapWindow(FDisplay, FWindow); + XSync(FDisplay, False); + + XDestroyWindow(FDisplay, FWindow); + End; + + { Free the invisible cursor } + If FX11InvisibleCursor <> None Then + Begin + XFreeCursor(FDisplay, FX11InvisibleCursor); + FX11InvisibleCursor := None; + End; +End; + +Procedure TX11WindowDisplay.internal_ShowCursor(AVisible : Boolean); + +Var + attr : TXSetWindowAttributes; + +Begin + If AVisible Then + attr.cursor := None { Use the normal cursor } + Else + attr.cursor := FX11InvisibleCursor; { Set the invisible cursor } + + XChangeWindowAttributes(FDisplay, FWindow, CWCursor, @attr); +End; + +Procedure TX11WindowDisplay.SetCursor(AVisible : Boolean); + +Begin + FCursorVisible := AVisible; + + If FFocus Then + internal_ShowCursor(FCursorVisible); +End; + +Procedure TX11WindowDisplay.EnterFullScreen; + +Begin + { Try to switch mode } + If Assigned(FModeSwitcher) Then + FModeSwitcher.SetBestMode(FWidth, FHeight); + + XSync(FDisplay, False); + + { Center the image } + FDestX := FModeSwitcher.Width Div 2 - FWidth Div 2; + FDestY := FModeSwitcher.Height Div 2 - FHeight Div 2; +End; + +Procedure TX11WindowDisplay.LeaveFullScreen; + +Begin + { Restore previous mode } + If Assigned(FModeSwitcher) Then + FModeSwitcher.RestorePreviousMode; + + XSync(FDisplay, False); +End; + +Procedure TX11WindowDisplay.HandleChangeFocus(ANewFocus : Boolean); + +Begin + { No change? } + If ANewFocus = FFocus Then + Exit; + + FFocus := ANewFocus; + If FFocus Then + Begin + { focus in } + If FFullScreen Then + EnterFullScreen; + + internal_ShowCursor(FCursorVisible); + End + Else + Begin + { focus out } + If FFullScreen Then + LeaveFullScreen; + + internal_ShowCursor(True); + End; + + XSync(FDisplay, False); +End; + +Procedure TX11WindowDisplay.HandleEvents; + +Var + e : TXEvent; + NewFocus : Boolean; + NewFocusSpecified : Boolean; + + Function UsefulEventsPending : Boolean; + + Var + tmpEvent : TXEvent; + + Begin + If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + If XCheckMaskEvent(FDisplay, FocusChangeMask Or + KeyPressMask Or KeyReleaseMask Or + ButtonPressMask Or ButtonReleaseMask Or + PointerMotionMask Or ExposureMask, @tmpEvent) Then + Begin + Result := True; + XPutBackEvent(FDisplay, @tmpEvent); + Exit; + End; + + Result := False; + End; + + Procedure HandleKeyEvent; + + Var + sym : TKeySym; + sym_modded : TKeySym; { modifiers like shift are taken into account here } + press : Boolean; + alt, shift, ctrl : Boolean; + uni : Integer; + key : TPTCKeyEvent; + buf : Array[1..16] Of Char; + + Begin + sym := XLookupKeySym(@e.xkey, 0); + XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); + uni := X11ConvertKeySymToUnicode(sym_modded); + alt := (e.xkey.state And Mod1Mask) <> 0; + shift := (e.xkey.state And ShiftMask) <> 0; + ctrl := (e.xkey.state And ControlMask) <> 0; + If e._type = KeyPress Then + press := True + Else + press := False; + + key := Nil; + Case sym Shr 8 Of + 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); + $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); + Else + key := TPTCKeyEvent.Create; + End; + FEventQueue.AddEvent(key); + End; + + Procedure HandleMouseEvent; + + Var + x, y : cint; + state : cuint; + PTCMouseButtonState : TPTCMouseButtonState; + + button : TPTCMouseButton; + before, after : Boolean; + cstate : TPTCMouseButtonState; + + Begin + Case e._type Of + MotionNotify : Begin + x := e.xmotion.x; + y := e.xmotion.y; + state := e.xmotion.state; + End; + ButtonPress, ButtonRelease : Begin + x := e.xbutton.x; + y := e.xbutton.y; + state := e.xbutton.state; + If e._type = ButtonPress Then + Begin + Case e.xbutton.button Of + Button1 : state := state Or Button1Mask; + Button2 : state := state Or Button2Mask; + Button3 : state := state Or Button3Mask; + Button4 : state := state Or Button4Mask; + Button5 : state := state Or Button5Mask; + End; + End + Else + Begin + Case e.xbutton.button Of + Button1 : state := state And (Not Button1Mask); + Button2 : state := state And (Not Button2Mask); + Button3 : state := state And (Not Button3Mask); + Button4 : state := state And (Not Button4Mask); + Button5 : state := state And (Not Button5Mask); + End; + End; + End; + Else + Raise TPTCError.Create('Internal Error'); + End; + + If (state And Button1Mask) = 0 Then + PTCMouseButtonState := [] + Else + PTCMouseButtonState := [PTCMouseButton1]; + If (state And Button2Mask) <> 0 Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2]; + If (state And Button3Mask) <> 0 Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3]; + If (state And Button4Mask) <> 0 Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4]; + If (state And Button5Mask) <> 0 Then + PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton5]; + + If (x >= 0) And (x < FWidth) And (y >= 0) And (y < FHeight) Then + Begin + If Not FPreviousMousePositionSaved Then + Begin + FPreviousMouseX := x; { first DeltaX will be 0 } + FPreviousMouseY := y; { first DeltaY will be 0 } + FPreviousMouseButtonState := []; + End; + + { movement? } + If (x <> FPreviousMouseX) Or (y <> FPreviousMouseY) Then + FEventQueue.AddEvent(TPTCMouseEvent.Create(x, y, x - FPreviousMouseX, y - FPreviousMouseY, FPreviousMouseButtonState)); + + { button presses/releases? } + cstate := FPreviousMouseButtonState; + For button := Low(button) To High(button) Do + Begin + before := button In FPreviousMouseButtonState; + after := button In PTCMouseButtonState; + If after And (Not before) Then + Begin + { button was pressed } + cstate := cstate + [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, True, button)); + End + Else + If before And (Not after) Then + Begin + { button was released } + cstate := cstate - [button]; + FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, False, button)); + End; + End; + + FPreviousMouseX := x; + FPreviousMouseY := y; + FPreviousMouseButtonState := PTCMouseButtonState; + FPreviousMousePositionSaved := True; + End; + End; + +Begin + NewFocusSpecified := False; + While UsefulEventsPending Do + Begin + XNextEvent(FDisplay, @e); + Case e._type Of + FocusIn : Begin + NewFocus := True; + NewFocusSpecified := True; + End; + FocusOut : Begin + NewFocus := False; + NewFocusSpecified := True; + End; + ClientMessage : Begin + If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = FAtomClose) Then + Halt(0); + End; + Expose : Begin + {...} + End; + KeyPress, KeyRelease : HandleKeyEvent; + ButtonPress, ButtonRelease, MotionNotify : HandleMouseEvent; + End; + End; + If NewFocusSpecified Then + HandleChangeFocus(NewFocus); +End; + +Procedure TX11WindowDisplay.Update; + +Begin + FPrimary.Put(FWindow, FGC, FDestX, FDestY); + + HandleEvents; +End; + +Procedure TX11WindowDisplay.Update(Const AArea : TPTCArea); + +Var + updatearea : TPTCArea; + tmparea : TPTCArea; + +Begin + tmparea := TPTCArea.Create(0, 0, FWidth, FHeight); + Try + updatearea := TPTCClipper.Clip(tmparea, AArea); + Try + FPrimary.Put(FWindow, FGC, updatearea.Left, updatearea.Top, + FDestX + updatearea.Left, FDestY + updatearea.Top, + updatearea.Width, updatearea.Height); + Finally + updatearea.Free; + End; + Finally + tmparea.Free; + End; + + HandleEvents; +End; + +Function TX11WindowDisplay.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; + +Var + tmpEvent : TXEvent; + +Begin + FreeAndNil(AEvent); + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + AEvent := FEventQueue.NextEvent(AEventMask); + + If AWait And (AEvent = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not AWait) Or (AEvent <> Nil); + Result := AEvent <> Nil; +End; + +Function TX11WindowDisplay.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; + +Var + tmpEvent : TXEvent; + +Begin + Repeat + { process all events from the X queue and put them on our FEventQueue } + HandleEvents; + + { try to find an event that matches the EventMask } + Result := FEventQueue.PeekEvent(AEventMask); + + If AWait And (Result = Nil) Then + Begin + { if the X event queue is empty, block until an event is received } + XPeekEvent(FDisplay, @tmpEvent); + End; + Until (Not AWait) Or (Result <> Nil); +End; + +Function TX11WindowDisplay.Lock : Pointer; + +Begin + Result := FPrimary.Lock; +End; + +Procedure TX11WindowDisplay.unlock; + +Begin +End; + +Procedure TX11WindowDisplay.GetModes(Var AModes : TPTCModeDynArray); + +Var + current_desktop_format, tmpfmt : TPTCFormat; + +Begin + If FModeSwitcher = Nil Then + FModeSwitcher := CreateModeSwitcher; + + current_desktop_format := Nil; + tmpfmt := TPTCFormat.Create(8); + Try + current_desktop_format := GetX11Format(tmpfmt); + + FModeSwitcher.GetModes(AModes, current_desktop_format); + Finally + tmpfmt.Free; + current_desktop_format.Free; + End; +End; + +Procedure TX11WindowDisplay.Palette(Const APalette : TPTCPalette); + +Var + pal : PUint32; + i : Integer; + +Begin + pal := APalette.Data; + If Not FFormat.Indexed Then + Exit; + For i := 0 To 255 Do + Begin + FColours[i].pixel := i; + + FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; + FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; + FColours[i].blue := (pal[i] And $FF) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); +End; + +Function TX11WindowDisplay.GetPitch : Integer; + +Begin + Result := FPrimary.pitch; +End; + +Function TX11WindowDisplay.CreateImage(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; + AFormat : TPTCFormat) : TX11Image; + +Begin + {$IFDEF ENABLE_X11_EXTENSION_XSHM} + If (PTC_X11_TRY_XSHM In FFlags) And XShmQueryExtension(ADisplay) Then + Begin + Try + LOG('trying to create a XShm image'); + Result := TX11ShmImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat); + Exit; + Except + LOG('XShm failed'); + End; + End; + {$ENDIF ENABLE_X11_EXTENSION_XSHM} + + LOG('trying to create a normal image'); + Result := TX11NormalImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat); +End; + +Function TX11WindowDisplay.CreateModeSwitcher : TX11Modes; + +Begin +{$IFDEF ENABLE_X11_EXTENSION_XRANDR} + If PTC_X11_TRY_XRANDR In FFlags Then + Try + LOG('trying to initialize the Xrandr mode switcher'); + Result := TX11ModesXrandr.Create(FDisplay, FScreen); + Exit; + Except + LOG('Xrandr failed'); + End; +{$ENDIF ENABLE_X11_EXTENSION_XRANDR} + +{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE} + If PTC_X11_TRY_XF86VIDMODE In FFlags Then + Try + LOG('trying to initialize the XF86VidMode mode switcher'); + Result := TX11ModesXF86VidMode.Create(FDisplay, FScreen); + Exit; + Except + LOG('XF86VidMode failed'); + End; +{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE} + + LOG('creating the standard NoModeSwitching mode switcher'); + Result := TX11ModesNoModeSwitching.Create(FDisplay, FScreen); +End; + +Function TX11WindowDisplay.GetX11Window : TWindow; + +Begin + Result := FWindow; +End; + +Function TX11WindowDisplay.GetX11GC : TGC; + +Begin + Result := FGC; +End; + +Function TX11WindowDisplay.IsFullScreen : Boolean; + +Begin + Result := FFullScreen; +End; + +Procedure TX11WindowDisplay.CreateColormap; { Register colour maps } + +Var + i : Integer; + r, g, b : Single; + +Begin + If FFormat.Bits = 8 Then + Begin + FColours := GetMem(256 * SizeOf(TXColor)); + If FColours = Nil Then + Raise TPTCError.Create('Cannot allocate colour map cells'); + FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen), + DefaultVisual(FDisplay, FScreen), AllocAll); + If FCMap = 0 Then + Raise TPTCError.Create('Cannot create colour map'); + XInstallColormap(FDisplay, FCMap); + XSetWindowColormap(FDisplay, FWindow, FCMap); + End + Else + FCMap := 0; + + { Set 332 palette, for now } + If (FFormat.Bits = 8) And FFormat.Direct Then + Begin + {Taken from PTC 0.72, i hope it's fine} + For i := 0 To 255 Do + Begin + r := ((i And $E0) Shr 5) * 255 / 7; + g := ((i And $1C) Shr 2) * 255 / 7; + b := (i And $03) * 255 / 3; + + FColours[i].pixel := i; + + FColours[i].red := Round(r) Shl 8; + FColours[i].green := Round(g) Shl 8; + FColours[i].blue := Round(b) Shl 8; + + Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; + End; + XStoreColors(FDisplay, FCMap, FColours, 256); + End; +End; diff --git a/packages/ptc/src/x11/xunikey.inc b/packages/ptc/src/x11/xunikey.inc new file mode 100644 index 0000000000..62f4d52d60 --- /dev/null +++ b/packages/ptc/src/x11/xunikey.inc @@ -0,0 +1,216 @@ + +Function X11ConvertKeySymToUnicode(sym : TKeySym) : Integer; + +Begin + If (sym >= $20) And (sym <= $7E) Then + Exit(sym); +{ Case sym Of + XK_BackSpace : Exit(8); + XK_Tab : Exit(9); + XK_Return : Exit(13); + XK_Escape : Exit(27); + End;} + Case sym Of + XKc_Cyrillic_GHE_bar : Exit($492); + XK_Cyrillic_ghe_bar : Exit($493); + XKc_Cyrillic_ZHE_descender : Exit($496); + XK_Cyrillic_zhe_descender : Exit($497); + XKc_Cyrillic_KA_descender : Exit($49A); + XK_Cyrillic_ka_descender : Exit($49B); + XKc_Cyrillic_KA_vertstroke : Exit($49C); + XK_Cyrillic_ka_vertstroke : Exit($49D); + XKc_Cyrillic_EN_descender : Exit($4A2); + XK_Cyrillic_en_descender : Exit($4A3); + XKc_Cyrillic_U_straight : Exit($4AE); + XK_Cyrillic_u_straight : Exit($4AF); + XKc_Cyrillic_U_straight_bar : Exit($4B0); + XK_Cyrillic_u_straight_bar : Exit($4B1); + XKc_Cyrillic_HA_descender : Exit($4B2); + XK_Cyrillic_ha_descender : Exit($4B3); + XKc_Cyrillic_CHE_descender : Exit($4B6); + XK_Cyrillic_che_descender : Exit($4B7); + XKc_Cyrillic_CHE_vertstroke : Exit($4B8); + XK_Cyrillic_che_vertstroke : Exit($4B9); + XKc_Cyrillic_SHHA : Exit($4BA); + XK_Cyrillic_shha : Exit($4BB); + + XKc_Cyrillic_SCHWA : Exit($4D8); + XK_Cyrillic_schwa : Exit($4D9); + XKc_Cyrillic_I_macron : Exit($4E2); + XK_Cyrillic_i_macron : Exit($4E3); + XKc_Cyrillic_O_bar : Exit($4E8); + XK_Cyrillic_o_bar : Exit($4E9); + XKc_Cyrillic_U_macron : Exit($4EE); + XK_Cyrillic_u_macron : Exit($4EF); + + XK_Serbian_dje : Exit($452); + XK_Macedonia_gje : Exit($453); + XK_Cyrillic_io : Exit($451); + XK_Ukrainian_ie : Exit($454); + XK_Macedonia_dse : Exit($455); + XK_Ukrainian_i : Exit($456); + XK_Ukrainian_yi : Exit($457); + XK_Cyrillic_je : Exit($458); + XK_Cyrillic_lje : Exit($459); + XK_Cyrillic_nje : Exit($45A); + XK_Serbian_tshe : Exit($45B); + XK_Macedonia_kje : Exit($45C); + XK_Ukrainian_ghe_with_upturn : Exit($491); + XK_Byelorussian_shortu : Exit($45E); + XK_Cyrillic_dzhe : Exit($45F); + XK_numerosign : Exit($2116); + XKc_Serbian_DJE : Exit($402); + XKc_Macedonia_GJE : Exit($403); + XKc_Cyrillic_IO : Exit($401); + XKc_Ukrainian_IE : Exit($404); + XKc_Macedonia_DSE : Exit($405); + XKc_Ukrainian_I : Exit($406); + XKc_Ukrainian_YI : Exit($407); + XKc_Cyrillic_JE : Exit($408); + XKc_Cyrillic_LJE : Exit($409); + XKc_Cyrillic_NJE : Exit($40A); + XKc_Serbian_TSHE : Exit($40B); + XKc_Macedonia_KJE : Exit($40C); + XKc_Ukrainian_GHE_WITH_UPTURN : Exit($490); + XKc_Byelorussian_SHORTU : Exit($40E); + XKc_Cyrillic_DZHE : Exit($40F); + XK_Cyrillic_yu : Exit($44E); + XK_Cyrillic_a : Exit($430); + XK_Cyrillic_be : Exit($431); + XK_Cyrillic_tse : Exit($446); + XK_Cyrillic_de : Exit($434); + XK_Cyrillic_ie : Exit($435); + XK_Cyrillic_ef : Exit($444); + XK_Cyrillic_ghe : Exit($433); + XK_Cyrillic_ha : Exit($445); + XK_Cyrillic_i : Exit($438); + XK_Cyrillic_shorti : Exit($439); + XK_Cyrillic_ka : Exit($43A); + XK_Cyrillic_el : Exit($43B); + XK_Cyrillic_em : Exit($43C); + XK_Cyrillic_en : Exit($43D); + XK_Cyrillic_o : Exit($43E); + XK_Cyrillic_pe : Exit($43F); + XK_Cyrillic_ya : Exit($44F); + XK_Cyrillic_er : Exit($440); + XK_Cyrillic_es : Exit($441); + XK_Cyrillic_te : Exit($442); + XK_Cyrillic_u : Exit($443); + XK_Cyrillic_zhe : Exit($436); + XK_Cyrillic_ve : Exit($432); + XK_Cyrillic_softsign : Exit($44C); + XK_Cyrillic_yeru : Exit($44B); + XK_Cyrillic_ze : Exit($437); + XK_Cyrillic_sha : Exit($448); + XK_Cyrillic_e : Exit($44D); + XK_Cyrillic_shcha : Exit($449); + XK_Cyrillic_che : Exit($447); + XK_Cyrillic_hardsign : Exit($44A); + XKc_Cyrillic_YU : Exit($42E); + XKc_Cyrillic_A : Exit($410); + XKc_Cyrillic_BE : Exit($411); + XKc_Cyrillic_TSE : Exit($426); + XKc_Cyrillic_DE : Exit($414); + XKc_Cyrillic_IE : Exit($415); + XKc_Cyrillic_EF : Exit($424); + XKc_Cyrillic_GHE : Exit($413); + XKc_Cyrillic_HA : Exit($425); + XKc_Cyrillic_I : Exit($418); + XKc_Cyrillic_SHORTI : Exit($419); + XKc_Cyrillic_KA : Exit($41A); + XKc_Cyrillic_EL : Exit($41B); + XKc_Cyrillic_EM : Exit($41C); + XKc_Cyrillic_EN : Exit($41D); + XKc_Cyrillic_O : Exit($41E); + XKc_Cyrillic_PE : Exit($41F); + XKc_Cyrillic_YA : Exit($42F); + XKc_Cyrillic_ER : Exit($420); + XKc_Cyrillic_ES : Exit($421); + XKc_Cyrillic_TE : Exit($422); + XKc_Cyrillic_U : Exit($423); + XKc_Cyrillic_ZHE : Exit($416); + XKc_Cyrillic_VE : Exit($412); + XKc_Cyrillic_SOFTSIGN : Exit($42C); + XKc_Cyrillic_YERU : Exit($42B); + XKc_Cyrillic_ZE : Exit($417); + XKc_Cyrillic_SHA : Exit($428); + XKc_Cyrillic_E : Exit($42D); + XKc_Cyrillic_SHCHA : Exit($429); + XKc_Cyrillic_CHE : Exit($427); + XKc_Cyrillic_HARDSIGN : Exit($42A); + +{ XKc_Greek_ALPHAaccent : Exit($); + XKc_Greek_EPSILONaccent : Exit($); + XKc_Greek_ETAaccent : Exit($); + XKc_Greek_IOTAaccent : Exit($); + XKc_Greek_IOTAdieresis : Exit($); + XKc_Greek_OMICRONaccent : Exit($); + XKc_Greek_UPSILONaccent : Exit($); + XKc_Greek_UPSILONdieresis : Exit($); + XKc_Greek_OMEGAaccent : Exit($); + XK_Greek_accentdieresis : Exit($); + XK_Greek_horizbar : Exit($); + XK_Greek_alphaaccent : Exit($); + XK_Greek_epsilonaccent : Exit($); + XK_Greek_etaaccent : Exit($); + XK_Greek_iotaaccent : Exit($); + XK_Greek_iotadieresis : Exit($); + XK_Greek_iotaaccentdieresis : Exit($); + XK_Greek_omicronaccent : Exit($); + XK_Greek_upsilonaccent : Exit($); + XK_Greek_upsilondieresis : Exit($); + XK_Greek_upsilonaccentdieresis : Exit($); + XK_Greek_omegaaccent : Exit($);} + XKc_Greek_ALPHA : Exit($391); + XKc_Greek_BETA : Exit($392); + XKc_Greek_GAMMA : Exit($393); + XKc_Greek_DELTA : Exit($394); + XKc_Greek_EPSILON : Exit($395); + XKc_Greek_ZETA : Exit($396); + XKc_Greek_ETA : Exit($397); + XKc_Greek_THETA : Exit($398); + XKc_Greek_IOTA : Exit($399); + XKc_Greek_KAPPA : Exit($39A); + XKc_Greek_LAMDA : Exit($39B); + XKc_Greek_MU : Exit($39C); + XKc_Greek_NU : Exit($39D); + XKc_Greek_XI : Exit($39E); + XKc_Greek_OMICRON : Exit($39F); + XKc_Greek_PI : Exit($3A0); + XKc_Greek_RHO : Exit($3A1); + XKc_Greek_SIGMA : Exit($3A3); + XKc_Greek_TAU : Exit($3A4); + XKc_Greek_UPSILON : Exit($3A5); + XKc_Greek_PHI : Exit($3A6); + XKc_Greek_CHI : Exit($3A7); + XKc_Greek_PSI : Exit($3A8); + XKc_Greek_OMEGA : Exit($3A9); + XK_Greek_alpha : Exit($3B1); + XK_Greek_beta : Exit($3B2); + XK_Greek_gamma : Exit($3B3); + XK_Greek_delta : Exit($3B4); + XK_Greek_epsilon : Exit($3B5); + XK_Greek_zeta : Exit($3B6); + XK_Greek_eta : Exit($3B7); + XK_Greek_theta : Exit($3B8); + XK_Greek_iota : Exit($3B9); + XK_Greek_kappa : Exit($3BA); + XK_Greek_lamda : Exit($3BB); + XK_Greek_mu : Exit($3BC); + XK_Greek_nu : Exit($3BD); + XK_Greek_xi : Exit($3BE); + XK_Greek_omicron : Exit($3BF); + XK_Greek_pi : Exit($3C0); + XK_Greek_rho : Exit($3C1); + XK_Greek_sigma : Exit($3C2); + XK_Greek_finalsmallsigma : Exit($3C3); + XK_Greek_tau : Exit($3C4); + XK_Greek_upsilon : Exit($3C5); + XK_Greek_phi : Exit($3C6); + XK_Greek_chi : Exit($3C7); + XK_Greek_psi : Exit($3C8); + XK_Greek_omega : Exit($3C9); + + End; + X11ConvertKeySymToUnicode := -1; +End; diff --git a/packages/ptc/tests/convtest.pas b/packages/ptc/tests/convtest.pas new file mode 100644 index 0000000000..ddfcfeeb07 --- /dev/null +++ b/packages/ptc/tests/convtest.pas @@ -0,0 +1,327 @@ +{$MODE objfpc} + +{$I endian.pas} + +Uses + SysUtils, ptc; + +Const + destXSize = {480}320; + destYSize = {300}200; + +Var + image : TPTCSurface; + surface : TPTCSurface; + format : TPTCFormat; + TestNum : Integer; + +Function fb(q : int32) : Integer; + +Begin + fb := 0; + While (q And 1) = 0 Do + Begin + Inc(fb); + q := q Shr 1; + End; +End; + +Function nb(q : int32) : Integer; + +Begin + nb := 0; + While q <> 0 Do + Begin + Inc(nb); + q := q And (q - 1); + End; +End; + +Procedure generic(src, dest : TPTCSurface); + +Var + X, Y : Integer; + XSize, YSize : Integer; + r, g, b : int32; + pix : int32; + Psrc, Pdest : Pchar8; + srcbits : Integer; + Srmask, Sgmask, Sbmask : int32; + Srmasknb, Sgmasknb, Sbmasknb : Integer; + Srmaskfb, Sgmaskfb, Sbmaskfb : Integer; + destbits : Integer; + Drmask, Dgmask, Dbmask : int32; + Drmasknb, Dgmasknb, Dbmasknb : Integer; + Drmaskfb, Dgmaskfb, Dbmaskfb : Integer; + +Begin + XSize := dest.width; + YSize := dest.height; + + srcbits := src.format.bits; + Srmask := src.format.r; + Sgmask := src.format.g; + Sbmask := src.format.b; + Srmasknb := nb(Srmask); + Sgmasknb := nb(Sgmask); + Sbmasknb := nb(Sbmask); + Srmaskfb := fb(Srmask); + Sgmaskfb := fb(Sgmask); + Sbmaskfb := fb(Sbmask); + + destbits := dest.format.bits; + Drmask := dest.format.r; + Dgmask := dest.format.g; + Dbmask := dest.format.b; + Drmasknb := nb(Drmask); + Dgmasknb := nb(Dgmask); + Dbmasknb := nb(Dbmask); + Drmaskfb := fb(Drmask); + Dgmaskfb := fb(Dgmask); + Dbmaskfb := fb(Dbmask); + +{ Writeln(Srmasknb, ' ', Drmasknb);} + + Psrc := src.lock; + Pdest := dest.lock; + + For Y := 0 To YSize - 1 Do + For X := 0 To XSize - 1 Do + Begin + Case srcbits Of + 32 : Begin + pix := (Pint32(Psrc))^; + Inc(Psrc, 4); + End; + 24 : Begin + {$IFDEF FPC_LITTLE_ENDIAN} + pix := (Psrc^) Or ((Psrc + 1)^ Shl 8) Or ((Psrc + 2)^ Shl 16); + {$ELSE FPC_LITTLE_ENDIAN} + pix := (Psrc^ Shl 16) Or ((Psrc + 1)^ Shl 8) Or ((Psrc + 2)^); + {$ENDIF FPC_LITTLE_ENDIAN} + Inc(Psrc, 3); + End; + 16 : Begin + pix := (Pshort16(Psrc))^; + Inc(Psrc, 2); + End; + 8 : Begin + pix := Psrc^; + Inc(Psrc); + End; + End; + + r := pix And Srmask; + g := pix And Sgmask; + b := pix And Sbmask; + r := r Shr Srmaskfb; + g := g Shr Sgmaskfb; + b := b Shr Sbmaskfb; + + If (Drmasknb - Srmasknb) >= 0 Then + r := r Shl (Drmasknb - Srmasknb) + Else + r := r Shr (Srmasknb - Drmasknb); + If (Dgmasknb - Sgmasknb) >= 0 Then + g := g Shl (Dgmasknb - Sgmasknb) + Else + g := g Shr (Sgmasknb - Dgmasknb); + If (Dbmasknb - Sbmasknb) >= 0 Then + b := b Shl (Dbmasknb - Sbmasknb) + Else + b := b Shr (Sbmasknb - Dbmasknb); + + r := r Shl Drmaskfb; + g := g Shl Dgmaskfb; + b := b Shl Dbmaskfb; + pix := r Or g Or b; + + Case destbits Of + 32 : Begin + (Pint32(Pdest))^ := pix; + Inc(Pdest, 4); + End; + 24 : Begin + {$IFDEF FPC_LITTLE_ENDIAN} + Pdest^ := pix And $FF; + (Pdest + 1)^ := (pix Shr 8) And $FF; + (Pdest + 2)^ := (pix Shr 16) And $FF; + {$ELSE FPC_LITTLE_ENDIAN} + Pdest^ := (pix Shr 16) And $FF; + (Pdest + 1)^ := (pix Shr 8) And $FF; + (Pdest + 2)^ := pix And $FF; + {$ENDIF FPC_LITTLE_ENDIAN} + Inc(Pdest, 3); + End; + 16 : Begin + (Pshort16(Pdest))^ := pix; + Inc(Pdest, 2); + End; + 8 : Begin + Pdest^ := pix; + Inc(Pdest); + End; + End; + End; + src.unlock; + dest.unlock; +End; + +Procedure test(sbits : Integer; sr, sg, sb : int32; + dbits : Integer; dr, dg, db, da : int32); + +Var + srcformat, destformat : TPTCFormat; + src, dest : TPTCSurface; + F : File; + +Begin + Writeln(sbits, ' ', sr, ' ', sg, ' ', sb, ' ', dbits, ' ', dr, ' ', dg, ' ', db, ' ', da); + srcformat := TPTCFormat.Create(sbits, sr, sg, sb); + destformat := TPTCFormat.Create(dbits, dr, dg, db, da); + src := TPTCSurface.Create(320, 200, srcformat); + dest := TPTCSurface.Create(destXSize, destYSize, destformat); + + generic(image, src); + src.copy(dest); +{ generic(src, dest);} + generic(dest, surface); + + src.Destroy; + dest.Destroy; + srcformat.Destroy; + destformat.Destroy; + + Inc(TestNum); + ASSign(F, 'test' + IntToStr(TestNum) + '.raw'); + Rewrite(F, 1); + BlockWrite(F, surface.lock^, surface.height * surface.pitch); + surface.unlock; + Close(F); +End; + +Procedure test(sbits : Integer; sr, sg, sb : int32; + dbits : Integer; dr, dg, db : int32); + +Begin + test(sbits, sr, sg, sb, dbits, dr, dg, db, 0); +End; + +Procedure load(surface : TPTCSurface; filename : String); + +Var + F : File; + width, height : Integer; + pixels : PByte; + y : Integer; + tmp : TPTCFormat; + tmp2 : TPTCPalette; + +Begin + ASSign(F, filename); + Reset(F, 1); + Seek(F, 18); + width := surface.width; + height := surface.height; + pixels := surface.lock; + For y := height - 1 DownTo 0 Do + BlockRead(F, pixels[width * y * 3], width * 3); + surface.unlock; +End; + +Begin + TestNum := 0; + Try + {$IFDEF FPC_LITTLE_ENDIAN} + format := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + {$ELSE FPC_LITTLE_ENDIAN} + format := TPTCFormat.Create(24, $000000FF, $0000FF00, $00FF0000); + {$ENDIF FPC_LITTLE_ENDIAN} + surface := TPTCSurface.Create(destXSize, destYSize, format); + + image := TPTCSurface.Create(320, 200, format); + load(image, '../examples/image.tga'); + format.Free; + + + Writeln('testing equal converters'); + {test equal converters} + test(32, $00FF0000, $0000FF00, $000000FF, 32, $00FF0000, $0000FF00, $000000FF); + test(24, $FF0000, $00FF00, $0000FF, 24, $FF0000, $00FF00, $0000FF); + test(16, $F800, $07E0, $001F, 16, $F800,$07E0, $001F); + test( 8, $E0, $1C, $03, 8, $E0, $1C, $03); + + Writeln('testing generic converters'); + {test generic} + test(32, $FF000000, $000000FF, $000FF000, 32, $000FF000, $0FF00000, $000000FF); + test(32, $FF000000, $000000FF, $000FF000, 24, $00FF00, $FF0000, $000000FF); + test(32, $FF000000, $000000FF, $000FF000, 16, $F000, $0F00, $00F0); + test(32, $FF000000, $000000FF, $000FF000, 8, $0C, $03, $F0); + test(24, $FF0000, $0000FF, $00FF00, 32, $000FF000, $0FF00000, $000000FF); + test(24, $FF0000, $0000FF, $00FF00, 24, $00FF00, $FF0000, $000000FF); + test(24, $FF0000, $0000FF, $00FF00, 16, $F000, $0F00, $00F0); + test(24, $FF0000, $0000FF, $00FF00, 8, $0C, $03, $F0); + test(16, $001F, $F800, $07E0, 32, $000FF000, $0FF00000, $000000FF); + test(16, $001F, $F800, $07E0, 24, $00FF00, $FF0000, $000000FF); + test(16, $001F, $F800, $07E0, 16, $F000, $0F00, $00F0); + test(16, $001F, $F800, $07E0, 8, $0C, $03, $F0); +// test(8, $03, $E0, $1C, 32, $000FF000, $0FF00000, $000000FF); {unsupported} +// test(8, $03, $E0, $1C, 24, $00FF00, $FF0000, $000000FF); {unsupported} +// test(8, $03, $E0, $1C, 16, $F000, $0F00, $00F0); {unsupported} +// test(8, $03, $E0, $1C, 8, $0C, $03, $F0); {unsupported} + + Writeln('testing specialized converters'); + {From 32 bit RGB 888} + test(32,$ff0000,$ff00,$ff,16,$f800,$7e0,$1f); {16RGB565 } + test(32,$ff0000,$ff00,$ff, 8,$e0,$1c,$3); { 8RGB332 } + test(32,$ff0000,$ff00,$ff,16,$7c00,$3e0,$1f); { 16RGB555 } + test(32,$ff0000,$ff00,$ff,24,$ff0000,$ff00,$ff); { 24RGB888 } + test(32,$ff0000,$ff00,$ff,32,$ff,$ff00,$ff0000); { 32BGR888 } + test(32,$ff0000,$ff00,$ff,16,$1f,$7e0,$f800); { 16BGR565 } + test(32,$ff0000,$ff00,$ff,16,$1f,$3e0,$7c00); { 16BGR555 } + test(32,$ff0000,$ff00,$ff,32,$ff000000,$ff0000,$ff00,$ff); { 32RGBA888 } + test(32,$ff0000,$ff00,$ff,32,$ff00,$ff0000,$ff000000,$ff); { 32BGRA888 } + test(32,$ff0000,$ff00,$ff,24,$ff,$ff00,$ff0000); { 24BGR888 } + {From 24 bit RGB 888} + test(24,$ff0000,$ff00,$ff,32,$ff0000,$ff00,$ff); { 32RGB888 } + test(24,$ff0000,$ff00,$ff,16,$f800,$7e0,$1f); { 16RGB565 } + test(24,$ff0000,$ff00,$ff, 8,$e0,$1c,$3); { 8RGB332 } + test(24,$ff0000,$ff00,$ff,16,$7c00,$3e0,$1f); { 16RGB555 } + test(24,$ff0000,$ff00,$ff,32,$ff,$ff00,$ff0000); { 32BGR888 } + test(24,$ff0000,$ff00,$ff,16,$1f,$7e0,$f800); { 16BGR565 } + test(24,$ff0000,$ff00,$ff,16,$1f,$3e0,$7c00); { 16BGR555 } + test(24,$ff0000,$ff00,$ff,32,$ff000000,$ff0000,$ff00,$ff); { 32RGBA888 } + test(24,$ff0000,$ff00,$ff,32,$ff00,$ff0000,$ff000000,$ff); { 32BGRA888 } + test(24,$ff0000,$ff00,$ff,24,$ff,$ff00,$ff0000); { 24BGR888 } + {From 16 bit RGB 565} + test(16,$f800,$7e0,$1f,32,$ff0000,$ff00,$ff); { 32RGB888 } + test(16,$f800,$7e0,$1f, 8,$e0,$1c,$3); { 8RGB332 } + test(16,$f800,$7e0,$1f,16,$7c00,$3e0,$1f); { 16RGB555 } + test(16,$f800,$7e0,$1f,24,$ff0000,$ff00,$ff); { 24RGB888 } + test(16,$f800,$7e0,$1f,32,$ff,$ff00,$ff0000); { 32BGR888 } + test(16,$f800,$7e0,$1f,16,$1f,$7e0,$f800); { 16BGR565 } + test(16,$f800,$7e0,$1f,16,$1f,$3e0,$7c00); { 16BGR555 } + test(16,$f800,$7e0,$1f,32,$ff000000,$ff0000,$ff00,$ff); { 32RGBA888 } + test(16,$f800,$7e0,$1f,32,$ff00,$ff0000,$ff000000,$ff); { 32BGRA888 } + test(16,$f800,$7e0,$1f,24,$ff,$ff00,$ff0000); { 24BGR888 } + {From 32 bit muhmu} + test(32,$ff00000,$3fc00,$ff,32,$ff0000,$ff00,$ff); { 32RGB888 } + test(32,$ff00000,$3fc00,$ff,16,$f800,$7e0,$1f); { 16RGB565 } + test(32,$ff00000,$3fc00,$ff, 8,$e0,$1c,$3); { 8RGB332 } + test(32,$ff00000,$3fc00,$ff,16,$7c00,$3e0,$1f); { 16RGB555 } + test(32,$ff00000,$3fc00,$ff,24,$ff0000,$ff00,$ff); { 24RGB888 } + test(32,$ff00000,$3fc00,$ff,32,$ff,$ff00,$ff0000); { 32BGR888 } + test(32,$ff00000,$3fc00,$ff,16,$1f,$7e0,$f800); { 16BGR565 } + test(32,$ff00000,$3fc00,$ff,16,$1f,$3e0,$7c00); { 16BGR555 } + test(32,$ff00000,$3fc00,$ff,32,$ff000000,$ff0000,$ff00,$ff); { 32RGBA888 } + test(32,$ff00000,$3fc00,$ff,32,$ff00,$ff0000,$ff000000,$ff); { 32BGRA888 } + test(32,$ff00000,$3fc00,$ff,24,$ff,$ff00,$ff0000); { 24BGR888 } + + + surface.Destroy; + image.Destroy; + Except + On error : TPTCError Do + error.report; + End; +End. diff --git a/packages/ptc/tests/endian.pas b/packages/ptc/tests/endian.pas new file mode 100644 index 0000000000..8641d3eb22 --- /dev/null +++ b/packages/ptc/tests/endian.pas @@ -0,0 +1,25 @@ +{$IFDEF VER1_0} + {$IFDEF ENDIAN_LITTLE} + {$DEFINE FPC_LITTLE_ENDIAN} + {$ENDIF ENDIAN_LITTLE} + {$IFDEF ENDIAN_BIG} + {$DEFINE FPC_BIG_ENDIAN} + {$ENDIF ENDIAN_BIG} +{$ENDIF VER1_0} + +{$IFDEF FPC_LITTLE_ENDIAN} + {$IFDEF FPC_BIG_ENDIAN} + {$FATAL Both FPC_LITTLE_ENDIAN and FPC_BIG_ENDIAN defined?!} + {$ENDIF FPC_BIG_ENDIAN} +{$ELSE FPC_LITTLE_ENDIAN} + {$IFNDEF FPC_BIG_ENDIAN} + {$FATAL Neither FPC_LITTLE_ENDIAN, nor FPC_BIG_ENDIAN defined?!} + {$ENDIF FPC_BIG_ENDIAN} +{$ENDIF FPC_LITTLE_ENDIAN} + +{$IFDEF FPC_LITTLE_ENDIAN} + {$INFO FPC_LITTLE_ENDIAN} +{$ENDIF FPC_LITTLE_ENDIAN} +{$IFDEF FPC_BIG_ENDIAN} + {$INFO FPC_BIG_ENDIAN} +{$ENDIF FPC_BIG_ENDIAN} diff --git a/packages/ptc/tests/view.pp b/packages/ptc/tests/view.pp new file mode 100644 index 0000000000..4f83c65bc3 --- /dev/null +++ b/packages/ptc/tests/view.pp @@ -0,0 +1,47 @@ +{$MODE objfpc} + +Uses + SysUtils, ptc; + +Var + console : TPTCConsole; + surface : TPTCSurface; + format : TPTCFormat; + pixels : Pint32; + width, height : Integer; + I : Integer; + F : File; + +Begin + Try + console := TPTCConsole.Create; + + format := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF); + surface := TPTCSurface.Create(320, 200, format); + + console.open('Random example', surface.width, surface.height, format); + + format.Free; + + For I := 1 To 100 Do + Begin + Writeln('test', I, '.raw'); + ASSign(F, 'test' + IntToStr(I) + '.raw'); + Reset(F, 1); + BlockRead(F, surface.lock^, surface.height * surface.pitch); + surface.unlock; + Close(F); + surface.copy(console); + console.update; + console.read.Free; + End; + + console.close; + console.Free; + surface.Free; + Except + On error : TPTCError Do + { report error } + error.report; + End; +End. |