* updates

install/demo/Makefile

@@ -1,94 +1,59 @@
-#
-#   $Id$
-#   This file is part of the Free Pascal run time library.
-#   Copyright (c) 1998 by the Free Pascal Development Team
-#
-#   Makefile for the Free Pascal Examples
-#
-#   See the file COPYING.FPC, included in this distribution,
-#   for details about the copyright.
-#
-#   This program is distributed in the hope that it will be useful,
-#   but WITHOUT ANY WARRANTY; without even the implied warranty of
-#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-
-#####################################################################
-# Include configuration makefile
-#####################################################################
-
-# Where are the include files ?
-CFG=../cfg
-#INC=../inc
-#PROCINC=../$(CPU)
-#OBJPAS=../objpas
-
-# Get some defaults for Programs and OSes.
-# This will set the following variables :
-# inlinux COPY REPLACE DEL INSTALL INSTALLEXE MKDIR
-# It will also set OPT for cross-compilation, and add required options.
-# also checks for config file.
-# it expects CFG INC PROCINC to be set !!
-include $(CFG)/makefile.cfg
-
-#####################################################################
-# Objects
-#####################################################################
-
-EXEOBJECTS=hello lines eratos magic qsort mandel blackbox
-UNITOBJECTS=
-
-#####################################################################
-# Main targets
-#####################################################################
-
-# Create Filenames
-EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
-UNITFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-UNITOFILES=$(addsuffix $(OEXT),$(UNITOBJECTS))
-
-.PHONY : all clean diffs install diffclean
-
-all : $(EXEFILES) $(UNITFILES)
-
-$(EXEFILES): %$(EXEEXT): %$(PASEXT)
-	$(PP) $(OPT) $* 
-
-$(UNITFILES): %$(PPUEXT): %$(PASEXT)
-	$(PP) $(OPT) $* 
-
-install : all
-ifdef EXEOBJECTS
-	$(MKDIR) $(BININSTALLDIR)
-	$(INSTALLEXE) $(EXEFILES) $(BININSTALLDIR)
-endif
-ifdef UNITOBJECTS
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(UNITFILES) $(UNITOFILES) $(UNITINSTALLDIR)
-endif
-
-clean:
-	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) $(PPAS) link.res log
-ifdef EXEOBJECTS
-	-$(DEL) $(EXEFILES)
-endif
-
-#####################################################################
-# Files
-#####################################################################
-
-#####################################################################
-# Default makefile targets
-#####################################################################
-
-include $(CFG)/makefile.def
-
-#
+#
+#   $Id$
+#   Copyright (c) 1998 by the Free Pascal Development Team
+#
+#   Makefile for demos
+#
+#   See the file COPYING.FPC, included in this distribution,
+#   for details about the copyright.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+
+#####################################################################
+# Defaults
+#####################################################################
+
+# Where are the files located
+MAKEFILEFPC=makefile.fpc
+
+# Where need we to place the executables/ppu/objects
+TARGETDIR=.
+
+
+#####################################################################
+# Real targets
+#####################################################################
+
+UNITOBJECTS=
+EXEOBJECTS=eratos qsort hello blackbox magic
+
+ifeq ($(OS_TARGET),win32)
+override EXEOBJECTS+=win32/winhello
+else
+override EXEOBJECTS+=mandel lines
+endif
+
+#####################################################################
+# Include default makefile
+#####################################################################
+
+include $(MAKEFILEFPC)
+
+
+#####################################################################
+# Dependencies
+#####################################################################
+
+
+#
 # $Log$
-# Revision 1.1  1998-09-11 10:55:20  peter
-#   + header+log
-#
-# Revision 1.1  1998/09/10 13:55:07  peter
+# Revision 1.2  1998-12-20 22:22:09  peter
 #   * updates
-#
-#
+#
+# Revision 1.3  1998/12/12 19:14:42  peter
+#   + DEFAULTUNITS to have a make all only compile the units
+#
+#

install/demo/makefile.fpc

@@ -0,0 +1,663 @@
+#
+#   $Id$
+#   Copyright (c) 1998 by the Free Pascal Development Team
+#
+#   Common makefile for Free Pascal
+#
+#   See the file COPYING.FPC, included in this distribution,
+#   for details about the copyright.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+
+#####################################################################
+# Force default settings
+#####################################################################
+
+# Latest release version
+override RELEASEVER:=0.99.9
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+PWD=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+ifeq ($(PWD),)
+nopwd:
+	@echo
+	@echo You need the GNU pwd,cp,mv,rm,install utils to use this makefile!
+	@echo Get ftp://tflily.fys.kuleuven.ac.be/pub/fpc/dist/gnuutils.zip
+	@echo
+	@exit
+else
+inlinux=1
+endif
+else
+PWD:=$(subst \,/,$(firstword $(PWD)))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+
+#####################################################################
+# Targets
+#####################################################################
+
+# Target OS
+ifndef OS_TARGET
+ifdef inlinux
+OS_TARGET=linux
+else
+ifdef inWinNT
+OS_TARGET=win32
+else
+OS_TARGET=go32v2
+endif
+endif
+endif
+
+# Source OS
+ifndef OS_SOURCE
+ifdef inlinux
+OS_SOURCE=linux
+else
+ifndef inWinNT
+OS_SOURCE=win32
+else
+OS_SOURCE=go32v2
+endif
+endif
+endif
+
+# CPU
+ifndef CPU
+CPU=i386
+endif
+
+# Options
+ifndef OPT
+OPT=
+endif
+
+# What compiler to use ?
+ifndef PP
+PP=ppc386
+endif
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used 
+ifndef LD
+LD=ld
+endif
+
+# Release ? Then force OPT and don't use extra opts via commandline
+ifdef RELEASE
+override OPT:=-Xs -OG2p2 -n
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override OPT+=-vwni
+endif
+
+#####################################################################
+# Shell commands
+#####################################################################
+
+# To copy pograms
+ifndef COPY
+COPY=cp -fp
+endif
+
+# To move pograms
+ifndef MOVE
+MOVE=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+DEL=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+DELTREE=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+INSTALL=install -m 644
+else
+INSTALL=$(COPY)
+# ginstall has the strange thing to stubify all .o files !
+#INSTALL=ginstall -m 644
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+INSTALLEXE=install -m 755
+else
+INSTALLEXE=$(COPY)
+# ginstall has the strange thing to stubify all .o files !
+#INSTALLEXE=ginstall -m 755
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+MKDIR=install -m 755 -d
+else
+MKDIR=ginstall -m 755 -d
+endif
+endif
+
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+PPAS=ppas.bat
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# Where is the ppumove program ?
+ifndef PPUMOVE
+PPUMOVE=ppumove
+endif
+
+# diff
+ifndef DIFF
+DIFF=diff
+endif
+
+# date
+ifndef DATE
+# first try go32v2 specific gdate
+DATE=$(strip $(wildcard $(addsuffix /gdate.exe,$(subst ;, ,$(PATH)))))
+# try generic date.exe
+ifeq ($(DATE),)
+DATE=$(strip $(wildcard $(addsuffix /date.exe,$(subst ;, ,$(PATH)))))
+# finally try for linux
+ifeq ($(DATE),)
+DATE=$(strip $(wildcard $(addsuffix /date,$(subst :, ,$(PATH)))))
+ifeq ($(DATE),)
+DATE=
+endif
+else
+DATE:=$(subst \,/,$(firstword $(DATE)))
+endif
+else
+DATE:=$(subst \,/,$(firstword $(DATE)))
+endif
+endif
+
+# Sed
+ifndef SED
+SED=$(strip $(wildcard $(addsuffix /sed.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(SED),)
+SED=$(strip $(wildcard $(addsuffix /sed,$(subst :, ,$(PATH)))))
+ifeq ($(SED),)
+SED=
+endif
+else
+SED:=$(subst \,/,$(firstword $(SED)))
+endif
+endif
+
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# Base dir
+ifdef PWD
+BASEDIR=$(shell $(PWD))
+endif
+
+# set the directory to the rtl base
+ifndef RTLDIR
+ifdef RTL
+RTLDIR=$(RTL)
+else
+RTLDIR:=$(BASEDIR)/../rtl
+endif
+endif
+
+# specify where units are.
+ifndef UNITDIR
+UNITDIR=$(RTLDIR)/$(OS_TARGET)
+ifeq ($(OS_TARGET),go32v1)
+UNITDIR=$(RTLDIR)/dos/go32v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+UNITDIR=$(RTLDIR)/dos/go32v2
+endif
+endif
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+PREFIXINSTALLDIR=/usr
+else
+PREFIXINSTALLDIR=/pp
+endif
+endif
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(RELEASEVER)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+
+#####################################################################
+# Install Directories based on BASEINSTALLDIR
+#####################################################################
+
+# Linux binary really goes to baseinstalldir
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(BASEINSTALLDIR)
+else
+LIBINSTALLDIR=$(BASEINSTALLDIR)/lib
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+ifdef inlinux
+UNITINSTALLDIR=$(BASEINSTALLDIR)/linuxunits
+else
+UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef STATIC_UNITINSTALLDIR
+ifdef inlinux
+STATIC_UNITINSTALLDIR=$(BASEINSTALLDIR)/staticunits
+else
+STATIC_UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)/static
+endif
+endif
+
+# set the directory where to install the units.
+ifndef SHARED_UNITINSTALLDIR
+ifdef inlinux
+SHARED_UNITINSTALLDIR=$(BASEINSTALLDIR)/sharedunits
+else
+SHARED_UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)/shared
+endif
+endif
+
+# set the directory where to install the libs (must exist)
+ifndef STATIC_LIBINSTALLDIR
+ifdef inlinux
+STATIC_LIBINSTALLDIR=$(BASEINSTALLDIR)/staticunits
+else
+STATIC_LIBINSTALLDIR=$(STATIC_UNITINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the libs (must exist)
+ifndef SHARED_LIBINSTALLDIR
+ifdef inlinux
+SHARED_LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+SHARED_LIBINSTALLDIR=$(SHARED_UNITINSTALLDIR)
+endif
+endif
+
+# Where the .msg files will be stored
+ifndef MSGINSTALLDIR
+ifdef inlinux
+MSGINSTALLDIR=$(BASEINSTALLDIR)/msg
+else
+MSGINSTALLDIR=$(BININSTALLDIR)
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(RELEASEVER)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add CPU define
+override PPOPTDEF=$(OPTDEF) -d$(CPU)
+
+# Load commandline OPT and add target and unit dir to be sure
+override PPOPT=$(OPT) -T$(OS_TARGET) -Fu$(UNITDIR) $(NEEDOPT)
+
+# Add include dirs INC and PROCINC
+ifdef INC
+override PPOPT+=-I$(INC)
+endif
+ifdef PROCINC
+override PPOPT+=-I$(PROCINC)
+endif
+ifdef OSINC
+override PPOPT+=-I$(OSINC)
+endif
+
+# Target dirs
+ifdef TARGETDIR
+override PPOPT+=-FE$(TARGETDIR)
+endif
+ifdef UNITTARGETDIR
+override PPOPT+=-FU$(UNITTARGETDIR)
+endif
+
+# Smartlinking
+ifeq ($(SMARTLINK),YES)
+ifeq ($(LIBTYPE),shared)
+override SMARTLINK=NO
+else
+override PPOPT+=-Cx
+endif
+endif
+
+# Add library type, for static libraries smartlinking is automatic used
+ifeq ($(LIBTYPE),shared)
+override PPOPT+=-CD
+else
+ifeq ($(LIBTYPE),static)
+override PPOPT+=-CS
+endif
+endif
+
+# Add library name
+ifneq ($(LIBNAME),)
+override PPOPT:=$(PPOPT) -o$(LIBNAME)
+endif
+
+# Add defines from PPOPTDEF to PPOPT
+override PPOPT:=$(PPOPT) $(PPOPTDEF)
+
+# Was a config file specified ?
+ifdef CFGFILE
+override PPOPT:=$(PPOPT) @$(CFGFILE)
+endif
+
+override COMPILER=$(PP) $(PPOPT)
+
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+
+# Executable extension
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.o2
+SMARTEXT=.so
+STATICLIBEXT=.ao
+SHAREDLIBEXT=.dll
+endif
+
+# determine libary extension.
+ifeq ($(LIBTYPE),static)
+LIBEXT=$(STATICLIBEXT)
+else
+LIBEXT=$(SHAREDLIBEXT)
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine with .pas extension is used
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+
+
+#####################################################################
+# Export commandline values, so nesting use the same values
+#####################################################################
+
+export OS_SOURCE OS_TARGET OPT OPTDEF CPU PP RELEASE VERBOSE
+export SMARTLINK LIBTYPE LIBNAME
+export BASEINSTALLDIR
+
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+# Create Filenames
+EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+UNITFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
+UNITOFILES=$(addsuffix $(OEXT),$(UNITOBJECTS))
+
+.PHONY : all clean install \
+         info cfginfo objectinfo installinfo filesinfo
+
+.SUFFIXES : $(EXEEXT) $(PPUEXT) $(PASEXT)
+
+ifdef DEFAULTUNITS
+all: units
+else
+all: units exes
+endif
+
+units: $(UNITFILES)
+
+exes: $(EXEFILES)
+
+# General compile rules
+%$(PPUEXT): %$(PASEXT)
+	$(COMPILER) $<
+
+%$(EXEEXT): %$(PASEXT)
+	$(COMPILER) $<
+
+
+
+#####################################################################
+# Install rules
+#####################################################################
+
+install : all
+ifdef EXEOBJECTS
+	$(MKDIR) $(BININSTALLDIR)
+	$(INSTALLEXE) $(EXEFILES) $(BININSTALLDIR)
+endif
+ifdef UNITOBJECTS
+	$(MKDIR) $(UNITINSTALLDIR)
+ifeq ($(SMARTLINK),YES)
+	$(INSTALL) $(LIBPREFIX)$(LIBNAME)$(LIBEXT) $(UNITINSTALLDIR)
+else
+	$(INSTALL) $(UNITFILES) $(UNITOFILES) $(UNITINSTALLDIR)
+endif
+endif
+
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+clean:
+	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) $(PPAS) link.res log
+	-$(DELTREE) *$(SMARTEXT)
+ifdef EXEOBJECTS
+	-$(DEL) $(EXEFILES)
+endif
+
+
+#####################################################################
+# Depend rules
+#####################################################################
+
+depend:
+	makedep $(UNITOBJECTS)
+
+#####################################################################
+# Info rules
+#####################################################################
+
+info: cfginfo objectinfo installinfo
+
+cfginfo:
+	@echo
+	@echo  == Configuration info ==
+	@echo
+	@echo  Source.... $(OS_SOURCE)
+	@echo  Target.... $(OS_TARGET)
+	@echo  Basedir... $(BASEDIR)
+	@echo  Pwd....... $(PWD)
+ifdef SED
+	@echo  Sed....... $(SED)
+endif
+	@echo
+
+objectinfo:
+	@echo
+	@echo  == Object info ==
+	@echo
+	@echo  UnitObjects... $(UNITOBJECTS)
+	@echo  ExeObjects.... $(EXEOBJECTS)
+	@echo
+
+installinfo:
+	@echo
+	@echo  == Install info ==
+	@echo
+	@echo  BaseInstallDir....... $(BASEINSTALLDIR)
+	@echo  BinInstallDir........ $(BININSTALLDIR)
+	@echo  UnitInstallDir....... $(UNITINSTALLDIR)
+	@echo  StaticUnitInstallDir. $(STATIC_UNITINSTALLDIR)
+	@echo  SharedUnitInstallDir. $(SHARED_UNITINSTALLDIR)
+	@echo  LibInstallDir........ $(LIBINSTALLDIR)
+	@echo  StaticLibInstallDir.. $(STATIC_LIBINSTALLDIR)
+	@echo  SharedLibInstallDir.. $(SHARED_LIBINSTALLDIR)
+	@echo  MsgInstallDir........ $(MSGINSTALLDIR)
+	@echo  DocInstallDir........ $(DOCINSTALLDIR)
+	@echo
+
+# try to get the files in the currentdir
+PASFILES:=$(wildcard *.pas)
+PPFILES:=$(wildcard *.pp)
+INCFILES:=$(wildcard *.inc)
+MSGFILES:=$(wildcard *.msg)
+ASFILES:=$(wildcard *.as)
+
+filesinfo:
+	@echo
+	@echo  == Files info ==
+	@echo
+ifdef PASFILES
+	@echo  Pas files are $(PASFILES)
+endif
+ifdef PPFILES
+	@echo  PP  files are $(PPFILES)
+endif
+ifdef INCFILES
+	@echo  Inc files are $(INCFILES)
+endif
+ifdef MSGFILES
+	@echo  Msg files are $(MSGFILES)
+endif
+ifdef ASFILES
+	@echo  As  files are $(ASFILES)
+endif
+

install/demo/mandel.pp

@@ -22,13 +22,22 @@ program mandel;
 }
 
 uses
+{$ifdef go32v2}
+  dpmiexcp,
+{$endif go32v2}
   Graph;
 
+{$ifdef go32v2}
+  {$ifndef ver0_99_8}
+    {$define has_colors_equal}
+  {$endif ver0_99_8}
+{$endif go32v2}
+
 const
   shift:byte=12;
 
 var
-  SerchPoint,ActualPoint,NextPoint       : PointType;
+  SearchPoint,ActualPoint,NextPoint       : PointType;
   LastColor                              : longint;
   Gd,Gm,
   Max_Color,Max_X_Width,
@@ -44,6 +53,18 @@ const
 type
     arrayType = array[1..50] of integer;
 
+{------------------------------------------------------------------------------}
+{$ifndef has_colors_equal}
+  function ColorsEqual(c1, c2 : longint) : boolean;
+    begin
+       ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or
+         ((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
+         ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
+         ((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
+    end;
+
+{$endif not has_colors_equal}
+
 {------------------------------------------------------------------------------}
 function CalcMandel(Point:PointType; z:integer) : Longint ;
 var
@@ -61,7 +82,9 @@ begin
     z :=z -1;
   until (Z=0) or (Xq + Yq > 4 );
   if Z=0 Then
-    CalcMandel:=1
+    CalcMandel:=(blue and $FFFFFF)
+  else if getMaxColor>255 then
+    CalcMandel:=(stdcolors[(z mod 254) + 1] and $FFFFFF)
   else
     CalcMandel:=(z mod Max_Color) + 1 ;
 end;
@@ -187,41 +210,41 @@ begin
       Position:=NewPosition(LastOperation);
       repeat
         LastOperation:=(Position+KK) and 7 ;
-        SerchPoint.X:=ActualPoint.X+Sx[LastOperation];
-        SerchPoint.Y:=ActualPoint.Y+Sy[LastOperation];
-        if ((SerchPoint.X < 0) or
-            (SerchPoint.X > Max_X_Width) or
-            (SerchPoint.Y < NextPoint.Y) or
-            (SerchPoint.Y > Y_Width)) then
+        SearchPoint.X:=ActualPoint.X+Sx[LastOperation];
+        SearchPoint.Y:=ActualPoint.Y+Sy[LastOperation];
+        if ((SearchPoint.X < 0) or
+            (SearchPoint.X > Max_X_Width) or
+            (SearchPoint.Y < NextPoint.Y) or
+            (SearchPoint.Y > Y_Width)) then
           goto L;
-        if (SerchPoint.X=NextPoint.X) and (SerchPoint.Y=NextPoint.Y) then
+        if (SearchPoint.X=NextPoint.X) and (SearchPoint.Y=NextPoint.Y) then
           begin
             Start:=true ;
             Found:=true ;
           end
         else
           begin
-            FoundColor:=GetPixel(SerchPoint.X,SerchPoint.Y) ;
+            FoundColor:=GetPixel(SearchPoint.X,SearchPoint.Y) ;
             if FoundColor = 0 then
               begin
-                FoundColor:= CalcMandel (SerchPoint,Zm) ;
-                Putpixel (SerchPoint.X,SerchPoint.Y,FoundColor) ;
+                FoundColor:= CalcMandel (SearchPoint,Zm) ;
+                Putpixel (SearchPoint.X,SearchPoint.Y,FoundColor) ;
                 if Flag then
-                  PutPixel (SerchPoint.X,Max_Y_Width-SerchPoint.Y,FoundColor) ;
+                  PutPixel (SearchPoint.X,Max_Y_Width-SearchPoint.Y,FoundColor) ;
               end ;
-            if FoundColor=LastColor then
+            if ColorsEqual(FoundColor,LastColor) then
               begin
-                if ActualPoint.Y <> SerchPoint.Y then
+                if ActualPoint.Y <> SearchPoint.Y then
                   begin
-                    if SerchPoint.Y = MerkY then
+                    if SearchPoint.Y = MerkY then
                       LineY[ActualPoint.Y]:=LineY[ActualPoint.Y]-1;
                     MerkY:= ActualPoint.Y ;
-                    LineY[SerchPoint.Y]:=LineY[SerchPoint.Y]+1;
+                    LineY[SearchPoint.Y]:=LineY[SearchPoint.Y]+1;
                   end ;
-                LineX[LineY[SerchPoint.Y],SerchPoint.Y]:=SerchPoint.X ;
-                if SerchPoint.Y > Ymax then Ymax:= SerchPoint.Y ;
+                LineX[LineY[SearchPoint.Y],SearchPoint.Y]:=SearchPoint.X ;
+                if SearchPoint.Y > Ymax then Ymax:= SearchPoint.Y ;
                   Found:=true ;
-                ActualPoint:=SerchPoint ;
+                ActualPoint:=SearchPoint ;
               end;
 L:
             KK:=KK+1;
@@ -242,19 +265,39 @@ end ;
 {------------------------------------------------------------------------------
                               MAINROUTINE
 ------------------------------------------------------------------------------}
+{$ifndef Linux}
+  var
+     error : word;
+{$endif not Linux}
 
 begin
+{$ifdef go32v2}
+  {$ifdef debug}
+  {$warning If the compilation fails, you need to recompile}
+  {$warning the graph unit with -dDEBUG option }
+  Write('Use linear ? ');
+  readln(st);
+  if st='y' then UseLinear:=true;
+  {$endif debug}
+{$endif go32v2}
 {$ifdef Linux}
   gm:=0;
   gd:=0;
 {$else}
-  gm:=$103;
+  if paramcount>0 then
+    begin
+       val(paramstr(1),gm,error);
+       if error<>0 then
+         gm:=$103;
+    end
+  else
+    gm:=$103;
   gd:=$ff;
   {$ifDEF TURBO}
     gd:=detect;
   {$endif}
 {$endif}
-  InitGraph(gd,gm,'D:\bp\bgi');
+  InitGraph(gd,gm,'');
   if GraphResult <> grOk then Halt(1);
   Max_X_Width:=GetMaxX;
   Max_y_Width:=GetMaxY;
@@ -270,7 +313,9 @@ begin
   dy:=(y1 - y2) / Max_Y_Width ;
   if abs(y1) = abs(y2) then
    begin
+{$ifndef NOFLAG}
      flag:=true;
+{$endif NOFLAG}
      Y_Width:=Max_Y_Width shr 1
    end
   else
@@ -280,14 +325,16 @@ begin
    end;
   NextPoint.X:=0;
   NextPoint.Y:=0;
-  LastColor:=CalcMandel(SerchPoint,zm);
+  LastColor:=CalcMandel(SearchPoint,zm);
   CalcBounds ;
+{$ifndef fpc_profile}
   readln;
+{$endif fpc_profile}
   CloseGraph;
 end.
 {
   $Log$
-  Revision 1.3  1998-09-11 10:55:25  peter
-    + header+log
+  Revision 1.4  1998-12-20 22:22:10  peter
+    * updates
 
 }

install/demo/nmandel.pp

@@ -1,360 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Gernot Tenchio
-
-    Mandelbrot Example using the Graph unit
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-program mandel;
-
-{
-  Mandelbrot example using the graph unit.
-
-  Note: For linux you need to run this program as root !!
-}
-
-uses
-{$ifdef go32v2}
-{$ifdef profile}
-{ profile needs only to be inserted in _USES
-  for version < 0.99.9 PM }
-  profile, 
-{$endif profile}
-  heaptrc,
-  dpmiexcp,
-{$endif go32v2}
-  Graph;
-
-{$ifdef FPC}
-{$ifdef go32v2}
-{$ifndef ver0_99_8}
-{$define has_colors_equal}
-{$endif ver0_99_8}
-{$endif go32v2}
-{$endif FPC}
-
-const
-  shift:byte=12;
-
-var
-  SearchPoint,ActualPoint,NextPoint       : PointType;
-  LastColor                              : longint;
-  Gd,Gm,
-  Max_Color,Max_X_Width,
-  Max_Y_Width,Y_Width                    : integer;
-  Y1,Y2,X1,X2,Dy,Dx                      : Real;
-  Zm                                     : Integer;
-  Flag                                   : boolean;
-  LineY                                  : array [0..600] OF BYTE;
-  LineX                                  : array [0..100,0..600] OF INTEGER;
-const
-    SX : array [0..7] OF SHORTINT=(-1, 0, 1, 1, 1, 0,-1,-1);
-    SY : array [0..7] OF SHORTINT=(-1,-1,-1, 0, 1, 1, 1, 0);
-type
-    arrayType = array[1..50] of integer;
-
-{------------------------------------------------------------------------------}
-{$ifndef has_colors_equal}
-  function ColorsEqual(c1, c2 : longint) : boolean;
-    begin
-       ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or
-         ((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
-         ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
-         ((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
-    end;
-    
-{$endif not has_colors_equal}
-
-{------------------------------------------------------------------------------}
-function CalcMandel(Point:PointType; z:integer) : Longint ;
-var
-  x,y,xq,yq,Cx,Cy : real ;
-begin
-  Cy:=y2 + dy*Point.y ;
-  Cx:=x2 + dx*Point.x ;
-  X:=-Cx ; Y:=-Cy ;
-  repeat
-    xq:=x * x;
-    yq:=y * y  ;
-    y :=x * y;
-    y :=y + y - cy;
-    x :=xq - yq - cx ;
-    z :=z -1;
-  until (Z=0) or (Xq + Yq > 4 );
-  if Z=0 Then
-    CalcMandel:=(blue and $FFFFFF)
-  else if getMaxColor>255 then
-    CalcMandel:=(stdcolors[(z mod 254) + 1] and $FFFFFF)
-  else
-    CalcMandel:=(z mod Max_Color) + 1 ;
-end;
-
-{-----------------------------------------------------------------------------}
-procedure Partition(var A : arrayType; First, Last : Byte);
-var
-  Right,Left : byte ;
-  V,Temp     : integer;
-begin
-    V := A[(First + Last) SHR 1];
-    Right := First;
-    Left := Last;
-    repeat
-      while (A[Right] < V) do
-        inc(Right);
-      while (A[Left] > V) do
-        Dec(Left);
-      if (Right <= Left) then
-        begin
-          Temp:=A[Left];
-          A[Left]:=A[Right];
-          A[Right]:=Temp;
-          Right:=Right+1;
-          Left:=Left-1;
-        end;
-    until Right > Left;
-    if (First < Left) then
-      Partition(A, First, Left);
-    if (Right < Last) then
-      Partition(A, Right, Last)
-end;
-
-{-----------------------------------------------------------------------------}
-function BlackScan(var NextPoint:PointType) : boolean;
-begin
-  BlackScan:=true;
-  repeat
-    if NextPoint.X=Max_X_Width then
-      begin
-        if NextPoint.Y < Y_Width then
-          begin
-            NextPoint.X:=0 ;
-            NextPoint.Y:=NextPoint.Y+1;
-          end
-        else
-          begin
-            BlackScan:=false;
-            exit;
-          end ; { IF }
-      end ; { IF }
-    NextPoint.X:=NextPoint.X+1;
-  until GetPixel(NextPoint.X,NextPoint.Y)=0;
-end ;
-
-{------------------------------------------------------------------------------}
-procedure Fill(Ymin,Ymax,LastColor:integer);
-var
- P1,P3,P4,P    : integer ;
- Len,P2        : byte ;
- Darray        : arraytype;
-begin
-  SetColor(LastColor);
-  for P1:=Ymin+1 to Ymax-1 do
-   begin
-     Len:=LineY[P1] ;
-     if Len >= 2 then
-      begin
-        for P2:=1 to Len do
-          Darray[P2]:=LineX[P2,P1] ;
-        if Len > 2 then
-          Partition(Darray,1,len);
-        P2:=1;
-        repeat
-          P3:= Darray[P2] ; P4:= Darray[P2 + 1];
-          if P3 <> P4 then
-           begin
-             line ( P3 , P1 , P4 , P1) ;
-             if Flag then
-              begin
-                P:=Max_Y_Width-P1;
-                line ( P3 , P , P4 , P ) ;
-              end;
-           end; { IF }
-          P2:=P2+2;
-        until P2 >= Len ;
-      end; { IF }
-   end; { FOR }
-end;
-
-{-----------------------------------------------------------------------------}
-Function NewPosition(Last:Byte):Byte;
-begin
-  newposition:=(((last+1) and 254)+6) and 7;
-end;
-
-{-----------------------------------------------------------------------------}
-procedure CalcBounds;
-var
-  lastOperation,KK,
-  Position                     : Byte ;
-  foundcolor                   : longint;
-  Start,Found,NotFound         : boolean ;
-  MerkY,Ymax                   : Integer ;
-label
-  L;
-begin
-  repeat
-    FillChar(LineY,SizeOf(LineY),0) ;
-    ActualPoint:=NextPoint;
-    LastColor:=CalcMandel(NextPoint,Zm) ;
-    putpixel (ActualPoint.X,ActualPoint.Y,LastColor);
-    if Flag then
-      putpixel (ActualPoint.X,Max_Y_Width-ActualPoint.Y,LastColor) ;
-    Ymax:=NextPoint.Y ;
-    MerkY:=NextPoint.Y ;
-    NotFound:=false ;
-    Start:=false ;
-    LastOperation:=4 ;
-    repeat
-      Found:=false ;
-      KK:=0 ;
-      Position:=NewPosition(LastOperation);
-      repeat
-        LastOperation:=(Position+KK) and 7 ;
-        SearchPoint.X:=ActualPoint.X+Sx[LastOperation];
-        SearchPoint.Y:=ActualPoint.Y+Sy[LastOperation];
-        if ((SearchPoint.X < 0) or
-            (SearchPoint.X > Max_X_Width) or
-            (SearchPoint.Y < NextPoint.Y) or
-            (SearchPoint.Y > Y_Width)) then
-          goto L;
-        if (SearchPoint.X=NextPoint.X) and (SearchPoint.Y=NextPoint.Y) then
-          begin
-            Start:=true ;
-            Found:=true ;
-          end
-        else
-          begin
-            FoundColor:=GetPixel(SearchPoint.X,SearchPoint.Y) ;
-            if FoundColor = 0 then
-              begin
-                FoundColor:= CalcMandel (SearchPoint,Zm) ;
-                Putpixel (SearchPoint.X,SearchPoint.Y,FoundColor) ;
-                if Flag then
-                  PutPixel (SearchPoint.X,Max_Y_Width-SearchPoint.Y,FoundColor) ;
-              end ;
-            if ColorsEqual(FoundColor,LastColor) then
-              begin
-                if ActualPoint.Y <> SearchPoint.Y then
-                  begin
-                    if SearchPoint.Y = MerkY then
-                      LineY[ActualPoint.Y]:=LineY[ActualPoint.Y]-1;
-                    MerkY:= ActualPoint.Y ;
-                    LineY[SearchPoint.Y]:=LineY[SearchPoint.Y]+1;
-                  end ;
-                LineX[LineY[SearchPoint.Y],SearchPoint.Y]:=SearchPoint.X ;
-                if SearchPoint.Y > Ymax then Ymax:= SearchPoint.Y ;
-                  Found:=true ;
-                ActualPoint:=SearchPoint ;
-              end;
-L:
-            KK:=KK+1;
-            if KK > 8 then
-              begin
-                Start:=true ;
-                NotFound:=true ;
-              end;
-          end;
-      until Found or (KK > 8);
-    until Start ;
-    if not NotFound then
-      Fill(NextPoint.Y,Ymax,LastColor) ;
-  until not BlackScan(NextPoint);
-end ;
-
-
-{------------------------------------------------------------------------------
-                              MAINROUTINE
-------------------------------------------------------------------------------}
-{$ifndef Linux}
-  var
-     error : word;
-     st : string;
-{$endif not Linux}
-     
-begin
-  {$ifdef go32v2}
-  {$ifdef debug}
-  {$warning If the compilation fails, you need to recompile}
-  {$warning the graph unit with -dDEBUG option }
-  Write('Use linear ? ');
-  readln(st);
-  if st='y' then UseLinear:=true;
-  {$endif debug}
-  {$endif go32v2}
-{$ifdef Linux}
-  gm:=0;
-  gd:=0;
-{$else}
-  if paramcount>0 then
-    begin
-       val(paramstr(1),gm,error);
-       if error<>0 then
-         gm:=$103;
-    end
-  else
-    gm:=$103;
-  gd:=$ff;
-  {$ifDEF TURBO}
-    gd:=detect;
-  {$endif}
-{$endif}
-  InitGraph(gd,gm,'D:\bp\bgi');
-  if GraphResult <> grOk then Halt(1);
-  Max_X_Width:=GetMaxX;
-  Max_y_Width:=GetMaxY;
-  Max_Color:=GetMaxColor-1;
-  ClearViewPort;
-
-  x1:=-0.9;
-  x2:= 2.2;
-  y1:= 1.25;
-  y2:=-1.25;
-  zm:=90;
-  dx:=(x1 - x2) / Max_X_Width ;
-  dy:=(y1 - y2) / Max_Y_Width ;
-  if abs(y1) = abs(y2) then
-   begin
-{$ifndef NOFLAG}
-     flag:=true;
-{$endif NOFLAG}
-     Y_Width:=Max_Y_Width shr 1
-   end
-  else
-   begin
-     flag:=false;
-     Y_Width:=Max_Y_Width;
-   end;
-  NextPoint.X:=0;
-  NextPoint.Y:=0;
-  LastColor:=CalcMandel(SearchPoint,zm);
-  CalcBounds ;
-{$ifndef fpc_profile}
-  readln;
-{$endif fpc_profile}
-  CloseGraph;
-end.
-{
-  $Log$
-  Revision 1.3  1998-11-20 10:16:00  pierre
-    * Found out the LinerFrameBuffer problem
-      Was an alignment problem in VesaInfoBlock (see graph.pp file)
-      Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test
-
-  Revision 1.2  1998/11/18 11:45:06  pierre
-   * LinearFrameBuffer test added
-
-  Revision 1.1  1998/11/17 18:17:53  pierre
-    + mandel changed for new graph unit (probably not very linux compatible !)
-
-  Revision 1.3  1998/09/11 10:55:25  peter
-    + header+log
-
-}

install/demo/win32/hello.pp

@@ -1,118 +0,0 @@
-{
-  $Id$
-  Copyright (c) 1996 by Charlie Calvert
-  Modifications by Florian Klaempfl
-
-  Standard Windows API application written in Object Pascal.
-  No VCL code included. This is all done on the Windows API
-  level.
-}
-
-{$APPTYPE GUI}
-{$MODE DELPHI}
-program Window1;
-
-uses
-  Strings, Windows;
-
-const
-  AppName = 'Window1';
-
-function WindowProc(Window: HWnd; AMessage, WParam,
-                    LParam: Longint): Longint; stdcall; export;
-
-  var
-     dc : hdc;
-     ps : paintstruct;
-     r : rect;
-
-begin
-  WindowProc := 0;
-
-  case AMessage of
-    wm_paint:
-      begin
-         dc:=BeginPaint(Window,@ps);
-         GetClientRect(Window,@r);
-         DrawText(dc,'Hello world by Free Pascal',-1,@r,
-           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
-         EndPaint(Window,ps);
-         Exit;
-      end;
-    wm_Destroy:
-      begin
-         PostQuitMessage(0);
-         Exit;
-      end;
-  end;
-
-  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
-end;
-
- { Register the Window Class }
-function WinRegister: Boolean;
-var
-  WindowClass: WndClass;
-begin
-  WindowClass.Style := cs_hRedraw or cs_vRedraw;
-  WindowClass.lpfnWndProc := WndProc(@WindowProc);
-  WindowClass.cbClsExtra := 0;
-  WindowClass.cbWndExtra := 0;
-  WindowClass.hInstance := system.MainInstance;
-  WindowClass.hIcon := LoadIcon(0, idi_Application);
-  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
-  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
-  WindowClass.lpszMenuName := nil;
-  WindowClass.lpszClassName := AppName;
-
-  Result := RegisterClass(WindowClass) <> 0;
-end;
-
- { Create the Window Class }
-function WinCreate: HWnd;
-var
-  hWindow: HWnd;
-begin
-  hWindow := CreateWindow(AppName, 'Hello world program',
-              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
-              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
-
-  if hWindow <> 0 then begin
-    ShowWindow(hWindow, CmdShow);
-    UpdateWindow(hWindow);
-  end;
-
-  Result := hWindow;
-end;
-
-
-var
-  AMessage: Msg;
-  i : byte;
-  hWindow: HWnd;
-  exename : pchar;
-
-begin
-  if not WinRegister then begin
-    MessageBox(0, 'Register failed', nil, mb_Ok);
-    Exit;
-  end;
-  hWindow := WinCreate;
-  if longint(hWindow) = 0 then begin
-    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
-    Exit;
-  end;
-
-  while GetMessage(@AMessage, 0, 0, 0) do begin
-    TranslateMessage(AMessage);
-    DispatchMessage(AMessage);
-  end;
-  Halt(AMessage.wParam);
-end.
-
-{
-  $Log$
-  Revision 1.1  1998-10-27 15:22:35  florian
-    + Initial revision
-
-}