* removed duplicate files after move

install/demo/blackbox.pp

@@ -1,198 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Michael Van Canneyt
-
-    Blackbox Game Example
-
-    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 blackbox;
-
-{
-  The object of the game is simple : You have a box of 9x9x9 cells.
-  you can enter a number of atoms that will be put in the box.
-  Then you can start shooting in the box with a laser beam.
-  You enter the coordinates where the beam enters the box.
-  (this must be on the edges, this means that one of the coordinates
-  must be 1 or 9...)
-  The beam will bounce off the atoms (using normal bouncing), and you
-  will be told where the beam exits.
-  From this you must guess where the atoms are...
-}
-
-Const MaxSize = 9;
-      MaxAtom = 10;
-
-Type TRow   = Array [0..MaxSize+1] of byte;
-     TPlane = Array [0..MaxSize+1] of TRow;
-     TCube  = Array [0..MaxSize+1] of TPlane;
-
-Var
-  Cube                 : TCube;
-  Count,Guessed,x,y,z  : Longint;
-  ans : string;
-
-Procedure FillCube;
-
-var i,x,y,z : longint;
-
-begin
-  randomize;
-  for x:=0 to maxsize+1 do
-    for y:=0 to maxsize+1 do
-      for z:=0 to maxsize+1 do
-        Cube[x,y,z]:=0;
-  repeat
-    Write ('Enter number of atoms (1-',maxatom,') : ');
-    readln (count);
-    if (count<1) or (count>MaxAtom) then
-      writeln ('Invalid value entered. Please try again.');
-  until (count>0) and (count<=MaxAtom);
-  for I:=1 to count do
-     begin
-     repeat
-       x:=Random(MaxSize)+1;
-       y:=Random(MaxSize)+1;
-       z:=Random(MaxSize)+1;
-     until Cube[x,y,z]=0;
-     Cube[x,y,z]:=1;
-     end;
-end;
-
-Procedure GetCoords (Var X,y,z : longint);
-
-begin
-  Write ('X : ');
-  readln (x);
-  write ('Y : ');
-  readln (y);
-  write ('z : ');
-  readln (z);
-end;
-
-Procedure GetStart (Var x,y,z : longint);
-
-Var OK : boolean;
-
-begin
-  Writeln ('Please enter beam start coordinates : ');
-  Repeat
-    GetCoords (x,y,z);
-    OK:=((X=1) or (X=MaxSize)) or ((y=1) or (Y=MaxSize)) or
-        ((Z=1) or (z=maxsize));
-    if Not OK then
-      writeln ('The beam should enter at an edge. Please try again');
-  until OK;
-end;
-
-Function GetGuess : boolean;
-
-Var OK : boolean;
-    x,y,z : longint;
-
-begin
-  Writeln ('Please enter atom coordinates : ');
-  Repeat
-    getcoords (x,y,z);
-    OK:=((X>=1) or (X<=MaxSize)) or ((y>=1) or (Y<=MaxSize)) or
-        ((Z>=1) or (z<=maxsize));
-    if Not OK then
-      writeln ('These are not valid coordinates. Please try again');
-  until OK;
-  GetGuess:=False;
-  If Cube[x,y,z]<0 then
-    Writeln ('You already had this one ! Trying to be clever, eh ?')
-  else if Cube[x,y,z]>0 then
-    begin
-    Writeln ('Correct guess !');
-    Cube[x,y,z]:=-Cube[x,y,z];
-    getguess:=true;
-    end
-  else
-    Writeln ('Wrong guess !');
-end;
-
-Procedure CalcExit (X,Y,Z : longint);
-
-var tx,ty,tz,dx,dy,dz : longint;
-
-begin
-  dx:=0;dy:=0;dz:=0;
-  if x=1 then dx:=1 else if x=MaxSize then dx:=-1;
-  if y=1 then dy:=1 else if y=MaxSize then dy:=-1;
-  if z=1 then dz:=1 else if z=MaxSize then dz:=-1;
-  writeln ('Direction : ',dx,',',dy,',',dz);
-  repeat
-  for tx:=-1 to 1 do
-    for ty:=-1 to 1 do
-      for tz:=-1 to 1 do
-        if Cube [X+tx,y+ty,z+tz]<>0 then
-          begin
-          dx:=dx-tx;
-          dy:=dy-ty;
-          dz:=dz-tz;
-          end;
-  if dx<>0 then dx:=dx div abs(dx);
-  if dz<>0 then dz:=dz div abs(dz);
-  if dy<>0 then dy:=dy div abs(dy);
-  x:=x+dx;y:=y+dy;z:=z+dz;
-  until ((x=0) or (x=MaxSize+1)) or ((y=0) or (y=maxsize+1)) or
-        ((z=0) or (z=maxsize+1));
-  Writeln ('Beam exited at : (',x-dx,',',y-dy,',',z-dz,')');
-end;
-
-{
-Procedure DumpCube ;
-
-Var x,y,z : longint;
-
-begin
-  for x:=1 to MaxSize do
-    for y:=1 to maxsize do
-      for z:=1 to maxsize do
-        if Cube[x,y,z]<>0 then
-          writeln ('Atom at (',x,',',y,',',z,')');
-end;
-}
-
-begin
-  FillCube;
-  Guessed:=0;
-  Repeat
-    repeat
-      Write ('Shoot, guess or quit (s/g/q) : ');
-      readln (ans);
-      ans[1]:=Upcase(ans[1]);
-      if not (ans[1] in ['S','G','Q']) then
-        writeln ('Invalid entry. Please try again.');
-    until ans[1] in ['S','G','Q'];
-    Case ans[1] of
-     'S' : begin
-           getstart (x,y,z);
-           calcexit (x,y,z);
-           end;
-     'G' : If GetGuess then Inc(Guessed);
-    end;
-  until (ans[1]='Q') or (guessed=count);
-  If Guessed=count then
-    Writeln ('Congratulations! All ',Count,' correct !')
-  else
-    Writeln ('Only ',guessed,' out of ',count,' correct...');
-end.
-
-{
-  $Log$
-  Revision 1.3  2000-02-22 03:14:17  alex
-  fixed the warning
-
-  Revision 1.2  1998/09/11 10:55:20  peter
-    + header+log
-
-}

install/demo/eratos.pp

@@ -1,63 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Eratos Example, Calculates all Prime Numbers from 1 to max
-
-    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 eratosthenes;
-
-  const
-     max = 1000000;
-  var
-     a : array[1..max] of boolean;
-
-  procedure eratos;
-
-    var
-       i,j : longint;
-
-    begin
-       a[1]:=false;
-       for i:=1 to max do
-         a[i]:=true;
-       for i:=2 to max div 2 do
-         if a[i] then
-           for j:=2 to max div i do
-             a[i*j]:=false;
-       writeln;
-       j:=0;
-       for i:=1 to max do
-        begin
-          if a[i] then
-           begin
-             write(i:7);
-             inc(j);
-             if (j mod 10)=0 then
-              writeln;
-           end;
-        end;
-       writeln;
-    end;
-
-  begin
-     write('Calculating the Prime Numbers from 1 to ',max,'...');
-     eratos;
-  end.
-
-{
-  $Log$
-  Revision 1.5  1998-09-11 10:55:21  peter
-    + header+log
-
-  Revision 1.4  1998/09/04 17:38:15  pierre
-    * the algorythm was wrong (unnecessary checks were made)
-}

install/demo/fpcgames.txt

@@ -1,297 +0,0 @@
-The FPC games docs...
-
---------------------------------------------------------------------
-NOTICE:
-
-The ported games (see below) were found on a site that claims to only have
-PD stuff, and the webmaster said that everything he published was sent to
-him with that purpose. We tried finding the persons mentioned in the mail
-over internet, but that failed.
-If there is somebody that claims authorship of these programs, please mail
[email protected], and the sources will be removed from our websites.
-
-SameGame can also use the API for mousecontrol. This because the RTL mouseunit
-MsMouse only exists under Go32V2. The API mouse routines work with Linux, but
-have (right now) a problem with GPM version 1.17. Use a different version if
-you can 1.15 works according to the developpers.
-
-The source code of FPCTRIS and SAMEGAME) are written by Marco van de Voort
-and are donated to the FPC project. The FPC project distributes all sources
-under a modified GNU license (much like the so called LGPL) see copying.fpc.
---------------------------------------------------------------------
-REQUEST:
-
-As a developper team, we don't want spend 90% of our time in creating demoes.
-If you have something nice, which explains not yet demonstrated features or
-technicques, mail contact us via [email protected], or add it to the
-contrib page.
-The readers are also encouraged to explore FPC's excellent documentation
-with many examples!!!!!
-
-------------------------------------------------------------------------------
-0 What are the FPC games?
-
-The FPC-games are a series of simple, small games written or ported by
-Marco van de Voort ([email protected]) as demos for the
-Free Pascal compiler (FPC) and its Run Time Libraries (RTL).
-The "ported" games were first used to test the compability of the GRAPH
-unit. Since we had them, and they were very likely PD or GPL, we decided
-to use them when we couldn't contact the authors
-
-Currently the games are
-
-  (Games written by Marco van de Voort)
-- FPCTris (v0.08)                       Tetr'ish game.
-- Samegame (v0.03)                      As found on e.g. GNOME.
-
- Other games:
-- Gravwars (Sohrab Ismail-Beigi?)       Simple angle and shoot game
-                                        (like TANK distributed with QBasic)
-- Maze (Randy Ding)                     Maze generator and "game"
-- Quad (Justin and Whitney Pierce)      Memory game but with 4 cards each.
-- Voxel(Marcin Borkowski or
-        Bas van Gaalen, depends on src) Displays a landscape in which you can
-                                        move.
-
-All "other games" games are simpler than my ones, though Quad has overall
-the most sophisticated graphics, and Maze a reasonably complicated algoritm
-(compared to the other ones)
-
-Most of these games use Gameunit.pp which contains some very simple
-generic routines:
-- textual and graphics mode safe input dialogue (replacement for readkey)
-- highscores (show, helper routines for entering scores etc)
-- wrappers for mouse via msmouse or API on other targets
-- Some routines needed for BP compability. (Go32 and cursor routines in Crt)
-
-To compile the games on non dos targets you have to change DEFINE the
-MouseAPI conditional in gameunit.pp (automatical for Linux).
-
-To get the graphics versions of fpctris and samegame, compile using
--dUsegraphics, the makefile should automatically build both.
-
-Future
---------
-
-- Some cards games (BlackJack, Poker, and two Dutch games called "Rikken" and
-   "Toepen") are in preparation
-- A server for Linux, so that Linux clients can connect to it for multiplayer
-   services. One server for all games, otherwise small games like this clog up
-   the number of free ports ;-)
-   This is also important because most of the cardsgames (except BlackJack)
-   can't be played against the computer, the AI is to difficult. (Poker is maybe
-   also possible)
-- More games
-- A fortune clone (far more sophisticated than everything here) to complete
-  the BSD games analogy
-
----------
-FPCTRIS
-
-Fpctris is a tetris class game, originally designed
-
-- to be distributed with FPC as Crt demo,
-- Keeping possible integration in the IDE in mind (would add 15k or so)
-- Svgalib version etc etc. Anyway, the engine is quite platform independant,
-   and can be ported to different platforms (also TUI,GUI) if needed.
-   (this has now be done. Graph seems fast enough)
-
-The current versions are still under development, but already playable even
-under telnet.
-
-TODO list:
-
-- (difficult, also interesting for Crt and IDE), get more terminals supported
-  under Linux. Specially I don't want to issue the escape sequence that rapes
-  your console to an IBM compat charset. Linux users don't like that.
-  (temporarily solved by doing this only on user request)
-
-- (Linux) Sockets multiplayer client system :-). Have actually started on it,
-   but are getting nowhere. The server will be separate and support more than
-   one game. So you get one port for several games.
-
-- Setup screen ((create) alternate blocks etc)
-
-- Commandline options/config file. (.rctetris per user :-))
-
-KNOWN BUGS:
-
- - Upperrow not used with some chars. (Requires shifting up). Possibly related
-   that very rarely "game over" appears when there's still one or two rows to
-   go. (Since the 5x5 version some of this has been removed. If you get a
-   L-shaped character and immediately rotate, the upper line is used)
- - Biggest problem at the moment is the delay procedure and its init on machines
-    under heavy load. Can't change that though. Only under heavy load, so a
-    less big problem on heavy machines.
- - Selection of colors don't take screen attribs into account. So figures can
-    seem to disappear on weird TTY's or 4Dos people using strange ANSI prompts.
-
-History:
-
-v0.00    First version with working gameplay, created during the Brussels
-          meeting. published on tflily.
-v0.01    Some work done, first version on my page. Most improvements done in
-         Brussels, too many to name here.
-v0.02  - Got rid of binary encoding, and calculating shapes etc when a new
-         figure is created. All is done on startup now. Adding characters
-         is simpler now.
-      - A lot of parameters are variables instead of constants.
-      - Experienced tetrissers press "e" once.
-      - Colors! Linux has the color default off (press "C")
-v0.03  (Only used at Stack, not on web)
-      - Keep on pushing arrow down no longer freezes FPCTris.
-      - Basic level system implemented.
-      - High ascii background in color mode.
-v0.04  (Only used at Stack, not on web)
-      - The push-down arrow fix removed the possibility to move the character
-         after arrow-down, which I liked much. Fixed. # of possible moves after
-         arrow-down also adjustable.
-      - Tried compiling with W32 compiler. RTE 216 (which is gpf I believe)
-         Is Crt unit. Hello World "Use crt" also gpf's.
-      - Removed the first, forgotten bugfix for the hickup problem. Now the
-         "feel" of the game is ok. When you push down, it goes down, but you
-         have the change to do one more move.
-v0.05  (Never used anywere, backup version before movement to 5x5 figures)
-      - More Score info
-      - Help possiblity
-      - Highscores. (also saved to file, and searched in the path)
-      - Entering highscores uses inputstr. Size boosts to 1200 lines. Yuck.
-      - Most functionality now implemented.
-v0.06 (To Peter)
-      - 5x5 figures including "The Cross". Worked almost rightaway, but figures
-         rotate a bit weird.
-      - Better rotation 5x5 system. Only smallest square around figure is
-         rotated.
-      - Better scores. Incl quadratic (progressive is a better word) scores for
-         multiple lines. Now it does matter if you remove 2 x 1 line or 2
-         lines at once.
-      - Some small other fixes.
-      - 'q' is also exit.
-
-v0.07  - Highscore table routines moved to gameunit. Gameunit.pp now required.
-
-v0.08 - FileMode in GameUnit fixed.
-      - Small error that never popped up fixed. Pierre found it by compiling with
-         checks on.
-      - Graph mode implemented. Hopefully it also works under Linux (read the
-        Graph unit is platform independant enough) Compile with -dUseGraphics.
-
-----------
-SameGame.
-
-Principle copied from KDE/GNOME.
-
-The principle: The playfield is a grid consisting out of 3 colors.
-You can mark a certain spot on the playfield, and all adjacent grid-cubes
-(horizontally or vertically) will also get marked by the computer.
-When you press the left button, and two or more cubes are marked, the marked
-cubes will disappear, and the playfield will colapse to the bottom left.
-This can be repeated until there are no more agregates. If the field is empty
-then, you receive a bonus.
-
-The trick is that the score for each disappearing aggregate of cubes is more
-than linear (0.25* quadratic right now) dependant on the number of cubes it
-contains.
-
-This means that removing 5 times an aggregate of 2 cubes will result in a far
-smaller score than one aggregate of 10 cubes. ( 5*2^2 < 10^2)
-
-TODO:
-
-[none]
-
-BUGS:
-
-- Maybe better algoritm for initial filling of playfield.
-- Runtime sizable playfield.
-
-HISTORY:
-
-v0.01 :
-       - Initial version.
-       - Slightly improved initial algoritm.
-
-v0.02  - Using gameunit. GPM support via API, but whole thing GPF's under Linux,
-          but works under Go32V2.
-       - Highscores,helpscreen, all small things that come with a decent finishing
-         of the concept
-v0.03  - Fix to game unit that upset configuration files under 0.99.13
-       - q,x and Escape now exit.
-       - Weirdly enough, mouse cursor disappears when moving over a black spot.
-          Playing with delays was unsuccesfull.
-       - Graphical support. Compile with -dUseGraphics
-
-----------
-Gravwars (author:Sohrab Ismail-Beigi)
-
-Specify angle and speed, and try to hit the other spaceship. Some planetoids
-exist that can bend the curve of the bullet/ray.
-The game uses is designed for TP4.0 and uses Turtle'ish drawing. So we
-use it as a test for TP4.0 Graph compability.
-
-TODO:
-- Use InputStr for input.
-
-BUGS/FLAWS : None, except that it is very basic (and not worth extending)
-
-HISTORY:
-
-v0.01 :
-       - Initial FPC port.
-----------
-MAZE    (Author Randy Ding)
-
-Nothing special, but from all FPC-games the one with a real algoritm.
-(some form of shortest path through a maze I guess) The others are much
-simpler as far as algoritms are concerned.
-
-The programs asks some simple parameters, and creates a more or less complex
-MAZE. The task for the player is to go from one side to the other:
-
-Use I,J,K,M or arrow keys to walk through the maze
-Hit X when you give up!
-
-TODO:
-- Use InputStr for input.
-- Help on screen if there is enough room?
-- Big mazes/very high resolutions?
-   (bigger than the current max 200x200 is unreadable on 1024/768)
-
-HISTORY
- v0.01 :
-       - Initial FPC port.
-
-------------
-QUAD
-
-My favorite of the other games, and by far the most work to port/clean up.
-
-The program deals some cards blind. It flips over maximal 4 cards, and if
-the 4 turned are the same, it removes them. (the game exists as a card game
-called MEMORY too, but only with two cards at the same time)
-You have to remove all the cards to win, and the highscore record
-the time. QUAD loads some pictures from quaddata.dat.
-
-TODO:
-- Use graphical versions of highscore.
-
-HISTORY
- v0.01 :
-       - Initial FPC port.
-
--------------
-Voxel, more a demo than a game.
-
-A program I already ported to M2 once. Also from SWAG I believe, but it
-has been cycling FIDOnets Pascal areas for years.
-
-The program displays a landscape in which you can move with the cursor keys.
-Exit with ESCAPE. A flabbergasting effect in just 150 lines.
-
-TODO:
-- Higher resolution (LFB) graphics?
-
-HISTORY
- v0.01 :
-       - Initial FPC port.
-

install/demo/fpctris.pp

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

install/demo/ftrisgr.inc

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

install/demo/ftristxt.inc

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

install/demo/gameunit.pp

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

install/demo/gravwars.pp

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

install/demo/hello.pp

@@ -1,22 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by the Free Pascal Development Team
-
-    Hello World Example
-
-    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 hello;
-
-  begin
-     writeln('Hello world');
-  end.
-  

install/demo/lines.pp

@@ -1,82 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Line Counter Example
-
-    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 count_lines;
-{
-  Program that counts number of Lines in a file
-}
-
-  uses
-     dos,crt;
-
-  type
-     td = array[1..10000] of byte;
-
-  var
-     lines : longint;
-     s : searchrec;
-     f : file;
-     d : ^td;
-{$ifdef tp}
-     count : word;
-     i,z   : integer;
-{$else}
-     count,i,z : longint;
-{$endif}
-
-  begin
-     lines:=0;
-     new(d);
-     if paramcount<1 then
-       begin
-          writeln('Usage: ',paramstr(0),' filename.ext [filename.ext] ...');
-          writeln('  Multiple File Names and Wild Cards Allowed:');
-          writeln('  Example: lines *.cpp stdio.h *.asm');
-          halt(1);
-       end;
-     for i:=1 to paramcount do
-       begin
-          findfirst(paramstr(i),archive,s);
-          while (doserror=0) do
-            begin
-               gotoxy(1,wherey);
-               write('                               ');
-               gotoxy(1,wherey);
-               write('Scanning: ',s.name);
-               assign(f,s.name);
-               reset(f,1);
-               while not(eof(f)) do
-                 begin
-                    blockread(f,d^,10000,count);
-                    for z:=1 to count do
-                      if d^[z]=10 then inc(lines);
-                 end;
-               close(f);
-               findnext(s);
-            end;
-       end;
-     dispose(d);
-     gotoxy(1,wherey);
-     write('                               ');
-     gotoxy(1,wherey);
-     if lines=1 then writeln('1 Line') else writeln(lines,' Lines');
-  end.
-{
-  $Log$
-  Revision 1.2  1998-09-11 10:55:23  peter
-    + header+log
-
-}
-  

install/demo/magic.pp

@@ -1,105 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Magic Square Example
-
-    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 magic;
-
-{
-  Calculate a magic square (sum of the row, colums and diagonals is equal
-}
-
-  const
-     maxsize = 11;
-
-  type
-     sqrtype = array[1..maxsize, 1..maxsize] of longint;
-
-  var
-     square : sqrtype;
-     size, row, sum : longint;
-
-  procedure makesquare(var sq : sqrtype;limit : longint);
-
-    var
-       num,r,c : longint;
-
-    begin
-       for r:=1 to limit do
-         for c:=1 to limit do
-           sq[r, c] := 0;
-       if (limit and 1)<>0 then
-         begin
-            r:=(limit+1) div 2;
-            c:=limit;
-            for num:=1 to limit*limit do
-              begin
-                 if sq[r,c]<>0 then
-                   begin
-                      dec(r);
-                      if r<1 then
-                        inc(r,limit);
-                      dec(c,2);
-                      if c<1 then
-                        inc(c,limit);
-                   end;
-                 sq[r,c]:=num;
-                 inc(r);
-                 if r>limit then
-                   dec(r,limit);
-                 inc(c);
-                 if c>limit then
-                   dec(c,limit);
-              end;
-         end;
-     end;
-
-  procedure writesquare(var sq : sqrtype;limit : longint);
-
-    var
-       row,col : longint;
-
-    begin
-       for row:=1 to Limit do
-         begin
-            for col:=1 to (limit div 2) do
-              write(sq[row,2*col-1]:4,' ',sq[row,2*col]:4,' ');
-            writeln(sq[row,limit]:4);
-         end;
-    end;
-
-begin
-  size:=3;
-  while (size<=maxsize) do
-    begin
-       writeln('Magic Square with size ',size);
-       writeln;
-       makesquare(square,size);
-       writesquare(square,size);
-       writeln;
-       sum:=0;
-       for row:=1 to size do
-         inc(sum,square[row,1]);
-       writeln('Sum of the rows,columns and diagonals = ', sum);
-       writeln;
-       writeln;
-       inc(size,2);
-    end;
-end.
-{
-  $Log$
-  Revision 1.2  1998-09-11 10:55:24  peter
-    + header+log
-
-}
-  

install/demo/mandel.pp

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

install/demo/maze.pp

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

install/demo/qsort.pp

@@ -1,84 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993-98 by the Free Pascal Development Team
-
-    QuickSort Example
-
-    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 quicksort;
-
-  const
-     max = 100000;
-
-  type
-     tlist = array[1..max] of longint;
-
-  var
-     data : tlist;
-
-
-procedure qsort(var a : tlist);
-
-    procedure sort(l,r: longint);
-      var
-         i,j,x,y: longint;
-      begin
-         i:=l;
-         j:=r;
-         x:=a[(l+r) div 2];
-         repeat
-           while a[i]<x do
-            inc(i);
-           while x<a[j] do
-            dec(j);
-           if not(i>j) then
-             begin
-                y:=a[i];
-                a[i]:=a[j];
-                a[j]:=y;
-                inc(i);
-                j:=j-1;
-             end;
-         until i>j;
-         if l<j then
-           sort(l,j);
-         if i<r then
-           sort(i,r);
-      end;
-
-    begin
-       sort(1,max);
-    end;
-
-var
-  i : longint;
-begin
-  write('Creating ',Max,' random numbers between 1 and 500000');
-  randomize;
-  for i:=1 to max do
-    data[i]:=random(500000);
-  writeln;
-  writeln('Sorting...');
-  qsort(data);
-  writeln;
-  for i:=1 to max do
-   begin
-     write(data[i]:7);
-     if (i mod 10)=0 then
-      writeln;
-   end;
-end.
-{
-  $Log$
-  Revision 1.2  1998-09-11 10:55:26  peter
-    + header+log
-
-}

install/demo/quad.pp

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

install/demo/samegame.pp

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

install/demo/voxel.pp

@@ -1,185 +0,0 @@
-{
-    $Id$
-
-    This program is part of the FPC demoes.
-    Copyright (C) 1999 by Marco van de Voort
-
-    A port of a more "dirty" graphical program, to demonstrate
-    some Go32 features. The program displays a landscape in which
-    you can move with the cursorkeys
-
-    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.
-
- **********************************************************************
-
-The sources for this game was found in SWAG, and was also posted to the
-International FIDO Pascal area.
-I assume that it is PD (both sources said nothing about the form of copyrights,
-but it was contributed to SWAG, which is generally PD)
-
-If there is somebody that claims authorship of these programs,
-please mail [email protected], and the sources will be removed from our
-websites.
-
-------------------------------------------------------------------------
-There was no real original, I reconstructed some from several versions.
-
-A voxel source from Swag patched for FPC.
-
-- The original author was unknown. I saw a different version which named
-  "Borek" (Marcin Borkowski), 2:480/25  as author.
-- Bas van Gaalen donated it to SWAG.
-- I, Marco van de Voort made some small FPC adjustments.
-- However one problem remained (wrapping of arrays), and Jonas Maebe mailed me
-   that glitch to me. This practically meant putting all those WORD()
-   typecasts in the array-parameters.
-
-Still BP compatible, Gameunit contains some BP alternatives for Go32
-procedures needed.}
-
-PROGRAM voxel;
-
-
-USES Crt,Dos {$IFDEF FPC}, Go32{$ENDIF};
-
-type lrgarr=array[0..65534] of byte;
-const
- pal:array[1..384] of byte=(
-  0,0,0,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,
-  7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,
-  56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,
-  11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,
-  34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,
-  7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,
-  44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,
-  19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,
-  35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,
-  57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,
-  27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,
-  58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,
-  48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,
-  8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,
-  63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);
-
-VAR
-  MP,Scr      : ^lrgarr;
-  rng         : array[0..320] of byte;
-  dir,i,x,y   : integer;
-
-function ncol(mc,n,dvd:integer):integer;
-var loc:integer;
-begin
-  loc:=(mc+n-random(2*n)) div dvd; ncol:=loc;
-  if loc>250 then ncol:=250; if loc<5 then ncol:=5
-end;
-
-procedure plasma(x1,y1,x2,y2:word);
-var xn,yn,dxy,p1,p2,p3,p4:word;
-begin
-  if (x2-x1<2) and (y2-y1<2) then
-   exit;
-  p1:=mp^[WORD(256*y1+x1)]; p2:=mp^[WORD(256*y2+x1)]; p3:=mp^[WORD(256*y1+x2)];
-  p4:=mp^[WORD(256*y2+x2)]; xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;
-  dxy:=5*(x2-x1+y2-y1) div 3;
-  if mp^[WORD(256*y1+xn)]=0 then mp^[WORD(256*y1+xn)]:=ncol(p1+p3,dxy,2);
-  if mp^[WORD(256*yn+x1)]=0 then mp^[WORD(256*yn+x1)]:=ncol(p1+p2,dxy,2);
-  if mp^[WORD(256*yn+x2)]=0 then mp^[WORD(256*yn+x2)]:=ncol(p3+p4,dxy,2);
-  if mp^[WORD(256*y2+xn)]=0 then mp^[WORD(256*y2+xn)]:=ncol(p2+p4,dxy,2);
-  mp^[WORD(256*yn+xn)]:=ncol(p1+p2+p3+p4,dxy,4);
-  plasma(x1,y1,xn,yn); plasma(xn,y1,x2,yn);
-  plasma(x1,yn,xn,y2); plasma(xn,yn,x2,y2);
-end;
-
-procedure draw(xp,yp,dir:integer);
-var z,zobs,ix,iy,iy1,iyp,ixp,x,y,s,csf,snf,mpc,i,j:integer;
-begin
-  fillchar(rng,sizeof(rng),200); zobs:=100+mp^[WORD(256*yp+xp)];
-  csf:=round(256*cos(Real(dir)/180*pi)); snf:=round(256*sin(Real(dir)/180*pi));
-  fillchar(scr^,64000,0);
-  for iy:=yp to yp+55 do
-   begin
-    iy1:=1+2*(iy-yp); s:=4+300 div iy1;
-    for ix:=xp+yp-iy to xp-yp+iy do
-     begin
-      ixp:=xp+((ix-xp)*csf+(iy-yp)*snf) shr 8;
-      iyp:=yp+((iy-yp)*csf-(ix-xp)*snf) shr 8;
-      x:=160+360*(ix-xp) div iy1;
-      if (x>=0) and (x+s<=318) then
-       begin
-        z:=mp^[WORD(iyp shl 8+ixp)]; mpc:=z shr 1;
-        if z<47 then z:=46;  y:=100+(zobs-z)*30 div iy1;
-        if (y<=199) and (y>=0) then
-         for j:=x to x+s do
-          begin
-           for i:=y to rng[j] do
-            scr^[WORD(320*i+j)]:=mpc;
-           if y<rng[WORD(j)] then rng[WORD(j)]:=y
-          end;
-      end;
-    end;
-  end;
-  {$IFDEF FPC}
-   DosMemPut($A000,0,Scr^,64000);
-  {$ELSE}
-   Move(Scr^,mem[$A000:0],64000);
-  {$ENDIF}
-end;
-
-VAR Reg : Registers;
-
-begin
-  writeln('creating landscape...');
-  randomize; x:=0; y:=0; dir:=0; new(mp); fillchar(mp^,65535,0);
-  new(scr); mp^[$0000]:=128; plasma(0,0,256,256);
-  Reg.ax:=$13;  Intr($10,Reg);
-{$IFDEF FPC}
-  Outportb($3C8,0);
-  for i:=1 to 384 do OutPortb($3c9,pal[i]);
-{$ELSE}
-  Port[$3C8] := 0;
-  for i:=1 to 384 do Port[$3c9] := pal[i];
-{$ENDIF}
-  repeat
-    dir:=dir mod 360;
-    draw(x,y,dir);
-    case readkey of
-      #0:case readkey of
-         #75:dec(dir,10);
-         #77:inc(dir,10);
-         #72:begin
-              y:=y+round(5*cos(Real(dir)/180*pi));
-              x:=x+round(5*sin(Real(dir)/180*pi));
-             end;
-         #80:begin
-              y:=y-round(5*cos(Real(dir)/180*pi));
-              x:=x-round(5*sin(Real(dir)/180*pi));
-             end;
-          end;
-      #27: begin
-            Reg.ax:=$3;
-            Intr($10,Reg);
-            halt
-          end
-    end
-  until false;
-end.
-{
-  $Log$
-  Revision 1.4  2000-03-08 22:20:04  alex
-  fixed warnings about type conversion
-
-  Revision 1.3  2000/02/22 04:12:42  alex
-  removed game unit reference for non fpc version
-
-  Revision 1.2  2000/01/03 13:51:08  marco
-   * Fixed broken comment
-
-  Revision 1.1  2000/01/01 14:58:01  marco
-   * initial version
-
-}