Catalog C

Young Persons Guide to BCPL Programming on the Raspberry Pi
by Martin Richards
mr@cl.cam.ac.uk http://www.cl.cam.ac.uk/~mr10/
Computer Laboratory University of Cambridge Revision date: Wed May 15 15:39:57 BST 2013 Abstract
The Raspberry Pi is a credit card sized computer with versions costing between 20 and 35. It runs a full version of the Linux Operating System. Its les are held on an SD card typically holding between 2 and 32 Giga-bytes of data. When connected to a power supply, a USB keyboard and mouse, and attached to a TV via an HDMI cable, it behaves like a regular laptop running Linux. Programs for it can be written in various languages such as Python, C and Java, and systems such as Squeak and Scratch are fun to use and well worth looking at. This document is intended to help people with no computing experience to learn to write, compile and run BCPL programs on the Raspberry Pi in as little as one or two days, even if they are as young as 10 years old.
Keywords
BCPL, Programming, Raspberry Pi, Graphics.
Acknowledgements
I would particularly like to thank Philip Hazel for his helpful advice on how to improve this document.
Contents
Preface 1 Setting up the Raspberry Pi 2 SD Card Initialisation 3 Introduction to Linux 3.1 The Filing System 3.2 The Desktop . . . . 3.3 Midori . . . . . . . 3.4 Editing Files . . . . 3.5 vi . . . . . . . . . 3.6 emacs . . . . . . . 4 The 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 4.10 4.11 4.12 4.13 4.14 4.15 4.16 4.17 v 1 5 11 13 15 16 17 17 19 23 24 29 32 40 41 45 48 50 51 55 56 58 61 62 63 64 70 76
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
. . . . . .
BCPL Cintcode System Installation of BCPL . . . . . . . . . . . . Hello World . . . . . . . . . . . . . . . . . Fibonacci . . . . . . . . . . . . . . . . . . Multiplication Table . . . . . . . . . . . . A Mathematicians Approach . . . . . . . Numbers . . . . . . . . . . . . . . . . . . . Applications of XOR and MOD . . . . . . . . 4.7.1 RSA Mathematical Details . . . . . Vectors . . . . . . . . . . . . . . . . . . . . Primes . . . . . . . . . . . . . . . . . . . . MANIFEST, GLOBAL and STATIC declarations Functions . . . . . . . . . . . . . . . . . . Solving the recurrence relation for C . . . Greatest Common Divisor . . . . . . . . . Powers . . . . . . . . . . . . . . . . . . . . Compilation . . . . . . . . . . . . . . . . . The Collatz Conjecture . . . . . . . . . . The Queens Problem . . . . . . . . . . . . ii
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . .
CONTENTS 4.18 4.19 4.20 4.21 4.22 4.23 4.24 4.25 4.26 Simple series . . . . . . . . . . . . e to 2000 decimal places . . . . . The 2 test . . . . . . . . . . . . ex . . . . . . . . . . . . . . . . . . The extraordinary number e 163 Digits of . . . . . . . . . . . . . More commands . . . . . . . . . . The VSPL Compiler . . . . . . . Summary of BCPL . . . . . . . . 4.26.1 Comments and GET . . . . 4.26.2 Sections . . . . . . . . . . 4.26.3 Declarations . . . . . . . . 4.26.4 Denitions . . . . . . . . . 4.26.5 Expressions . . . . . . . . 4.26.6 Commands . . . . . . . . 4.26.7 Constant expressions . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
iii 79 82 86 86 88 94 98 98 99 99 100 100 100 100 102 103 105 105 110 113 115 119 121 124 128 140 169 184 200 219 249 256
5 Interactive Graphics in BCPL using 5.1 Introduction . . . . . . . . . . . . . 5.2 The dragon curve . . . . . . . . . . 5.3 Collatz Revisited . . . . . . . . . . 5.4 sdlinfo.b . . . . . . . . . . . . . . . 5.5 Graphs . . . . . . . . . . . . . . . . 5.6 Gradients . . . . . . . . . . . . . . 5.7 Events . . . . . . . . . . . . . . . . 5.8 eix and rotation . . . . . . . . . . . 5.9 Ball and Bucket Game . . . . . . . 5.10 Moon Lander . . . . . . . . . . . . 5.11 A 3D Demo . . . . . . . . . . . . . 5.12 drawtigermoth.b . . . . . . . . . . 5.13 Tigermoth Flight Simulator . . . . A sdl.h B sdl.b
SDL . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
. . . . . . . . . . . . .
iv
CONTENTS
Preface
When a new programming language is designed it is invariably strongly inuenced by languages that preceded it. One thread of related languages is: Algol -> CPL -> BCPL -> B -> C -> C++ -> Java, indicating that BCPL is just a small link in the chain from the development of Algol in the late 1950s to Java in the 1980s. BCPL is particularly easy to learn and is thus a good choice as a rst programming language. It is freely available via my home page (www.cl.cam.ac.uk/~mr10) and the only le to download is called bcpl.tgz. This is easy to decompress and install on the Raspberry Pi and so, in very little time, you can have a usable BCPL system running on your machine. The main topics covered by this document are: How to connect the Raspberry Pi to a television, keyboard, mouse, and power supply. How to initialise its SD card with a version of the Linux Operating System. How to login to the Raspberry Pi followed by a brief description of a few Linux Shell commands. How to obtain and install BCPL on the Raspberry Pi. Then follows a series of examples showing how to write, compile and run BCPL programs. Near the end there are some example programs involving interactive graphics using the BCPL interface to the SDL graphics library. Finally, there is a section outlining some of the debugging aid provided by the BCPL system. Professional computer scientists require a reasonable grounding in mathematics and so some mathematics has been included in this document, but even though some is of university level, the approach taken requires very little mathematical background, and should be understandable by most young people. But if this is not to your taste, skip any sections remotely connected with mathematics.
vi
CONTENTS
Chapter 1 Setting up the Raspberry Pi

The Raspberry Pi is a credit card sized computer that runs the freely available Linux Operating System. I recommend using the Model B version, as shown in Figure 1.1, since it is more powerful and not much more expensive than Model A. It is powered by a typical mobile phone charger using a micro USB connector, but be careful to choose a charger that can supply at least 700 milli-amps.
Figure 1.1: Raspberry Pi with connectors The Raspberry Pi can be connected to a TV using an HDMI cable although an analogue connection is also available. With some early versions of Linux for the Raspberry Pi, the HDMI connection failed to work properly. Luckily these early problems seem to have gone away with later versions of the software. 1
CHAPTER 1. SETTING UP THE RASPBERRY PI
A USB keyboard and mouse is required and a combined wireless keyboard and touch pad is particularly convenient since it allows you to sit in the comfort of an armchair with the the keyboard on your knee and the Raspberry Pi neatly hidden behind the TV. The lack of unsightly trailing cables is a clear bonus and leaving the second USB socket free is an added advantage. My favourite keyboard is made by Sandstrm (available from PC World for about 30). A radio keyboard with a separate mouse might be even better. The picture of the Raspberry Pi shows the tiny USB radio dongle for the keyboard to the left, the HDMI cable above and the micro USB connector for the charger to the right. Figure 1.2 shows the Raspberry Pi fully connected only requiring the HDMI lead to be connected to a TV and the charger plugged into a socket. Notice that at the right side of the machine, you can see part of the blue SD memory card which has to be preloaded with a suitable version of Linux. If you have access to the internet, you can plug a suitable ethernet cable into the Raspberry Pi. This is not absolutely necessary but does have many advantages, particularly for the automatic setting of the date and time, web browsing and downloading software.
Figure 1.2: Raspberry Pi and keyboard fully connected The SD card should have a size between 2 and 32 GBytes, although I recommend initially using a card of between 4 and 8 GBytes. Unfortunately some SD cards seem not to work. There are several good web pages supplied by the Raspberry Pi community that describe how to load the Linux image into the SD card. The version of Linux I currently use allows me to login as user pi with password raspberry leaving me connected to a bash shell waiting for Linux commands.
3 Figure 1.3 shows a more extensive setup of the Raspberry Pi. This time it is connected to the internet by cable and has a powered 4-port USB Hub connected to the second USB port. The Hub itself is connected to a 500 Gbyte USB disc drive. The screen shows a typical LXDE desktop with a Midori web browser showing some photos and a terminal session demonstrating the BCPL Cintcode System.
Figure 1.3: A more extensive setup
CHAPTER 1. SETTING UP THE RASPBERRY PI
Chapter 2 SD Card Initialisation

The SD memory card must be initialised with a suitable version of Linux and this chapter outlines how this can be done. Since it is potentially a dangerous operation I strongly recommend you look at the various tutorials and videos on the Web supplied by members of the Raspberry Pi community. A good place to start is to do a google search on: Raspberry Pi SD card setup, and also look at the web page: www.raspberrypi.org/downloads. You will need access to a desktop or laptop computer running some version of Windows, OSX or Linux, and a connection to the internet. I used a laptop computer (called solestreet) running Linux to perform the download and all the operations needed to initialise the SD card. I strongly recommend using Linux and in particular the Wubi version of Ubuntu Linux for many reasons. Firstly, it is easy to install on Windows machines without needing the tricky and potentially dangerous job of repartitioning your hard disc. It allocates one large le on Windows to hold the entire Linux ling system. I would recommend allocating 20 Gbytes if you can spare that much, but less will work. You can uninstall Wubi Linux in exactly the same way you uninstall other Windows programs, and again there is no need to repartition the hard disc. Secondly, it has a lot in common with the Linux system you will be using on the Raspberry Pi, including, for instance, the apt-get mechanism for downloading and installing Linux packages. Finally, it already has most of the commands installed such as ls, cd, df, dd, sudo, parted, e2fsck, fdisk and resize2fs that you will need when setting up the SD card. Even if some are absent, they are easily obtained by commands such as: sudo apt-get install parted. A further advantage is that all the fragments of terminal sessions in this chapter were run using the Wubi version of Linux on my laptop. I believe Wubi Linux already has the Workspace Switcher program which allows to the switch easily between four separate screens. Two other programs I strongly recommend installing are Terminator which is a brilliant terminal program and emacs which is my favourite screen editor for editing text les. If suitably congured, emacs will give dierent colours to reserved words, strings, comments and other lexical features of BCPL programs making them easier to 5
CHAPTER 2. SD CARD INITIALISATION
read. I would also recommend installing emacs on the Raspberry Pi for the same reason. Details of how to use emacs will be given later. Using a web browser you should be able to download a suitable Linux image. The recommended Debian squeeze is ideal and the one I used was called: 2012-07-15-wheezy-raspian.zip, but its name keeps changing as updates are made. The zip le can be expanded to produce the image le called: 2012-07-15-wheezy-raspian.img. I connected a 500 Gbyte external USB disc drive to the laptop and so had plenty of disc space for both the zip and image les. The USB drive turned out to have name /media/TOSHIBA\ EXT and so I changed to this directory, created a subdirectory directory called raspi and made it the current directory. The commands used were: solestreet:$ cd /media/TOSHIBA\ EXT solestreet:$ mkdir raspi solestreet:$ cd raspi solestreet:$ I used a web browser to download debian6-19-04-2012.zip into this directory and inspected the result. solestreet:$ ls -lrt total 453696 -rw------- 1 mr10 mr10 461001289 Jul 23 14:07 2012-07-15-wheezy-raspbian.zip solestreet:$ I then checked the checksum using sha1sum and expanded the le using unzip. solestreet:$ sha1sum 2012-07-15-wheezy-raspbian.zip 3947412babbf63f9f022f1b0b22ea6a308bb630c 2012-07-15-wheezy-raspbian.zip solestreet:$ solestreet:$ unzip 2012-07-15-wheezy-raspbian.zip Archive: 2012-07-15-wheezy-raspbian.zip inflating: 2012-07-15-wheezy-raspbian.img solestreet:$ ls -lrt total 2344600 -rw------- 1 mr10 mr10 1939865600 Jul 15 20:45 2012-07-15-wheezy-raspbian.img -rw------- 1 mr10 mr10 461001289 Jul 23 14:07 2012-07-15-wheezy-raspbian.zip solestreet:$
7 This takes some time so be patient, but when it completes, it will have created the le 2012-07-15-wheezy-raspbian.img. The size of this image is very nearly 2 Gbytes which just ts on a 2 Gbyte SD card, but later images are likely to be bigger so it would be wise to buy SD cards of at least 4 Gbytes. Now come the tricky and potentially dangerous part. This le represents the complete image of what must be written to the SD card destroying everything that was previously on it. If you accidently write it to the wrong place, you may well make your laptop or desktop unusable, so great care is required. My laptop has a slot for an SD card and so can be conveniently used to initialise the card. First, I executed the df -h command producing the following output. solestreet:$ df -h Filesystem Size /dev/sda6 32G udev 743M tmpfs 300M none 5.0M none 750M /dev/sda7 100M /dev/sda2 4.0G /dev/sdb1 466G solestreet:$
Used Avail Use% Mounted on 16G 14G 53% / 4.0K 743M 1% /dev 840K 300M 1% /run 8.0K 5.0M 1% /run/lock 344K 750M 1% /run/shm 75M 20M 80% /boot 2.5G 1.6G 63% /dose 25G 441G 6% /media/TOSHIBA EXT
I then inserted a suitable SD card (a Verbatim 4Gbyte card) and ran the command again giving: solestreet:$ df Filesystem /dev/sda6 udev tmpfs none none /dev/sda7 /dev/sda2 /dev/sdb1 /dev/mmcblk0p1 /dev/mmcblk0p2 solestreet:$ -h Size 32G 743M 300M 5.0M 750M 100M 4.0G 466G 58M 3.7G
Used Avail Use% Mounted on 16G 14G 53% / 4.0K 743M 1% /dev 852K 300M 1% /run 8.0K 5.0M 1% /run/lock 344K 750M 1% /run/shm 75M 20M 80% /boot 2.5G 1.6G 63% /dose 25G 441G 6% /media/TOSHIBA EXT 34M 24M 59% /media/18DA-FFB9 1.5G 2.0G 43% /media/a6b2691a-99d8-47...
This shows that the SD card was called /dev/mmcblk0 and already had two partitions on it, one of size 58 Mbytes and the other of size 3.7 Gbytes. I unmounted
both these two partitions using the umount command twice and used the sudo dd command to copy the Raspian Linux image to the SD card. This is the command that required special care since mistakes can make your machine unusable. The commands used were as follows: solestreet:$ umount /dev/mmcblk0p1 solestreet:$ umount /dev/mmcblk0p2 solestreet:$ solestreet:$ sudo dd bs=1M if=2012-07-15-wheezy-raspbian.img of=/dev/mmcblk0 [sudo] password for mr10: 1850+0 records in 1850+0 records out 1939865600 bytes (1.9 GB) copied, 468.454 s, 4.1 MB/s solestreet:$ As can be seen, this took 468 seconds or nearly 8 minutes so patience is again required. I then extracted the SD card after issuing the sync command to ensure that all disc transfers have completed. solestreet:$ sync solestreet:$ I re-inserted the SD card to see what it contained.
solestreet:$ df Filesystem /dev/sda6 udev tmpfs none none /dev/sda7 /dev/sda2 /dev/sdb1 /dev/mmcblk0p1 /dev/mmcblk0p2 solestreet:$ -h Size 32G 743M 300M 5.0M 750M 100M 4.0G 466G 56M 1.8G
Used Avail Use% Mounted on 16G 14G 53% / 4.0K 743M 1% /dev 852K 300M 1% /run 8.0K 5.0M 1% /run/lock 344K 750M 1% /run/shm 75M 20M 80% /boot 2.5G 1.6G 63% /dose 25G 441G 6% /media/TOSHIBA EXT 34M 23M 61% /media/1AF7-904A 1.3G 439M 75% /media/8fe3c9ad-c8f5-4b39-aec2-f6e8dba743e0
solestreet:$ solestreet:$ cd /media/8fe3c9ad-c8f5-4b39-aec2-f6e8dba743e0 solestreet:$ ls bin dev home lost+found mnt proc run selinux sys usr boot etc lib media opt root sbin srv tmp var solestreet:$
9 Note that the horrible looking cd command is easy to type because you only have to input cd /media/8 and then press the Tab key for bash to ll in the rest of the le name automatically. The directory home contains all the home directories of users permitted to use the machine, however at this stage no users are set up. The rst time this image is run on the Raspberry Pi, it creates a user called pi with password raspberry. Our next job is to extract the SD card from the laptop and insert it into the SD slot on the Raspberry Pi. Assuming a suitable keyboard and mouse is attached and the HDMI lead is connected to a TV or suitable screen, we can plug in the power and watch the Raspberry Pi initialise itself. The rst time you use a new image extra initialisation is done and it asks you a few conguration questions. You should agree to let the system expand the root ling system to ll your SD card. If you do not you will be limited to a mere 2 Gbyte of ling system which is unlikely to be enough for your needs. The other options are up to you. You should then let the system reboot. With the default settings, the system will eventually issue a prompt looking something like the following. Debian GNU/Linux wheezy/sid raspberrypi tty1 raspberrypi login: You should respond by typing the user name pi remembering to press the Enter key. It will then ask for the password and your response should be: raspberry, again remembering to press the Enter key. It will then output about 6 lines ending with a Linux shell prompt such as the following: Debian GNU/Linux 6.0 raspberrypi tty1 pi@raspberrypi:~$ If you get this far, you are now in business and can begin to use Linux on your Raspberry Pi. Well done! If your Raspberry Pi was connected to the internet, it will have automatically set the time and date, but if not you should correct the time using the sudo date command as shown below. pi@raspberrypi:~$ date Tue Apr 17 14:15:04 BST 2012 pi@raspberrypi:~$ sudo date --set="2012-04-23 12:27" Mon Apr 23 12:27:00 BST 2012 pi@raspberrypi:~$ date Mon Apr 23 12:27:04 BST 2012 pi@raspberrypi:~$
10
Chapter 3 Introduction to Linux

Assuming that you have successfully logged in to the Raspberry Pi as user pi and have the time and date correctly set you should be looking at a bash prompt such as: pi@raspberrypi:~$ This line is inviting you to type in a command to the bash shell. If you press the Enter key several times, it will repeatedly respond with the prompt. Shell commands are lines of text with the rst word being the command name and later words being arguments supplied to the given command. For instance, if you type echo hello the command name is echo and its argument is hello. If you then press the Enter key, the machine will load and run the echo command outputing its argument as shown below. pi@raspberry:~$ echo hello hello pi@raspberry:~$ After doing that, the shell is again waiting for a command. Errors are common while typing in commands and the shell is helpful in allowing you to correct such mistakes before they are executed. Suppose you typed echohello without a space between the command name and its argumnent, you could delete the last ve characters by pressing the backspace key (often labelled <-BkSp) ve times then press the space bar followed by hello. Alternatively, you could press the left arrow key ve times to position the cursor over the h of hello. Pressing the space bar now will insert a space before the h and pressing the Enter key will now cause the corrected command to be executed. The shell remembers commands you have recently executed and you can search through them using the up and down arrow keys. So rather typing 11
12
CHAPTER 3. INTRODUCTION TO LINUX
echo hello again, you can nd it by pressing the up arrow key once and execute it by pressing the Enter key. Believe it or not, this is an incredibly useful feature. We will now look at a few shell commands that you are likely to nd useful. Firstly, there is the command date which outputs information you might expect. But if the output is wrong, the time and date should be corrected using the sudo date command shown in the previous chapter. When you have nished using the computer, it is important to close it down properly by issuing the command sudo shutdown -h now and wait until the machine says it has halted. There are literally hundreds of shell command available in Linux and many of them are held in the directories /bin and /usr/bin. You can see them by typing ls /bin and ls /usr/bin. But dont be frightened, you will only need to know about perhaps 10 or 15 of them to make eective use of Linux. Linux is to a large extent self documented, and it is possible to learn what commands do using the man command. This is a rather sophicticated command that will display manual pages describing almost any command available in the system. The output is primarily aimed and professional users and is highly detailed and often incomprehensible to beginners, but you should just try it once to see the kind of information that is available. Try typing man echo. This give a detailed description of the echo command which you can step through using the up and down arrow keys and the space bar. To exit from the man command, type q. As an example of a really long and complicated command description, try man bash and repeatedly press the space bar until you get tired, remembering to press q to return to the shell. Again dont be frightened by what you have just seen, you will only be using a tiny subset of the features available in bash and this document will show you the ones you are most likely to use. Sometimes you want to do something but dont know the name of the command to use. The man -k command can be helpful in this situation, but it is not always as helpful as you would like. When I rst started to use Linux, many years ago, I wanted to delete a le. On previous systems I had used, commands such as del, delete or erase had done the job. Typing man -k delete lists about 13 commands that have something to do with deletion but none of the suggested commands would actually delete a le. In Linux deleting a le is called removal and is performed by the rm command. It appears in the rather long list generated by man -k remove. The whoami outputs your user identier. On the Raspberry Pi this is likely to be pi. As has been seen the date command will will either generate the date and time or let you set the date. The command cal 2012 will output a calendar for the year 2012. As an interesting oddity try cal 1752 since this was the year in which some days in
3.1. THE FILING SYSTEM
13
September were deleted when there was a switch from the Julian to the Gregorian calendar. Type man cal for details. To execute a command that requires special privileges, you should precede it by sudo. It will normally require you to type in a password before executing the given command. Many other commands are associated with les and the ling system. Some of these are described in the next section.
3.1
The Filing System
As we have seen, the SD card holds the image of the Linux system including the built-in shell commands and much more, but it also holds data that you can create. This data is held in les and continues to exist for use on another day, even after you turn the computer o. Files have names and are grouped in directories (often called folders). They typically contain text that can be output to the screen, but les are frequently used for other purposes. The echo command, used above, is a le but not a text le. It is actually a program containing a long and complicated sequence of instructions for the computer to obey in order to output its argument to the screen. At this stage it may seem like magic, but after reading this document you will hopefully have a better understanding of how programs are written and how they work. Directories can contain other directories as well as les and so it is natural to think of the ling system as a tree of les (the leaves) and directories (the branches). At the lowest level is the root which is referred by the special name /. We can list the contents of this using the command ls / as can be seen below. pi@raspberrypi:~$ ls / bin dev lib opt sbin srv usr boot etc media proc sd sys var Desktop home mnt root selinux tmp pi@raspberrypi:~$ It turns out that all the items in the root directory are themselves directories mostly belonging to the system. As can be seen, one is called home which contains the so called home directories of all users permitted to use this computer. Currently there is only one user called pi setup. We can show this by listing the contents of home. pi@raspberrypi:~$ ls /home pi pi@raspberrypi:~$
14
We can also list the contents of the pi directory by the following. pi@raspberrypi:~$ ls /home/pi pi@raspberrypi:~$ This indicates that it is apparently empty. However, it does contain les whose names start with dots (.) that are normally hidden. These can be seen using the -a option as in: pi@raspberrypi:~$ ls -a /home/pi . .. .bash_history .config .lesshst pi@raspberrypi:~$ An absolute le name is a sequence of names separated by slashes (/) and starting with a slash. Such compound names can become quite long. For instance the full le name of the echo command is /usr/bin/echo as can be found using the which command. To reduce the need to frequently have to type long names, Linux has the concept of a current working directory. The absolute name of this directory can be found using the pwd command as in: pi@raspberrypi:~$ pwd /home/pi pi@raspberrypi:~$ File names not starting with a slash are called relative le names and are interpreted as les within the current working directory. In this case, it is as though /home/pi/ is prepended to the relative le name. You can change the current directory using the cd command, as the following sequence of commands shows. pi@raspberrypi:~$ cd /usr/local/lib pi@raspberrypi:/usr/local/lib$ pwd /usr/local/lib pi@raspberrypi:/usr/local/lib$ cd pi@raspberrypi:/usr/local/lib$ pwd /home/pi A few more Linux commands relating to les will be given in the next chapter after you have installed the BCPL system.
3.2. THE DESKTOP
15
3.2
The Desktop
After you have logged in to the Raspberry Pi (typically as user pi with password raspberry), you will probably nd yourself connected to a bash shell waiting for you to enter Linux commands. It is normally more convenient to work within a graphics session since this allows you to interact with several programs using separate windows. To start a graphics session type the command startx. After about 10 seconds you will be in a graphics session. You can then use the mouse to move about the screen and press the mouse buttons to cause actions to take place. At the very bottom of the screen there are some tiny icons that are particularly useful. If you move the mouse pointer over one of them and wait a second, it will probably bring up a tiny message reminding you what the icon is for. The little red icon at the bottom right of the screen allows you to logout of the graphics session, returning to the original bash shell. The reminder message for this icon just says logout. A little further to the left is an icon showing the current time. If you place the mouse pointer over it, it will tell you todays date. Provided you are connected to the internet or you have set the time and date manually, the displayed date should be correct. Two icons at the bottom near the left side allow you to quickly switch between two separate desktops (Desktop 1 and Desktop 2). This is particularly useful if you want quick access to many windows. Perhaps, one for editing, one for compilations, one for running compiled programs in, one for web browsing, etc, etc. The icon at the bottom left looks like a white bird with a forked tail. If you click the left mouse button on this, it brings up a menu containing about nine items such as Accessories, Education, internet, Programming, and several others. For many of these, if you place the mouse pointer over them they bring up sub menus. You can explore these menus using either the mouse or the arrow keys. Suppose you highlight the Accessories menu item, pressing Right Arrow will highlight the rst item in the Accessories sub menu. You can move up and down this sub menu with the Up and Down Arrow keys, and if you select Leafpad, say, and press Enter, a window will appear that allows you to create and edit text les. This is a fairly primitive editor similar to Notepad on computers running Windows. On the left side of the screen, you should nd a column of larger icons for commonly used applications. Probably the most important ones for our purposes are Midori a web browser and LXTerminal which creates a window allowing you to interact with a bash shell. If you place the mouse pointer over the LXTerminal icon and then click the left mouse button twice quickly (within about half a second), a window will appear with a bash shell prompt. You can test it by typing commands such as echo hello or date. The top line of the window is called the Title Bar. At its centre will be the title, typically pi@raspberry:~. If you place the mouse pointer in the title bar and hold down the left button you will nd you can drag the window to a new position on the screen. If you place
16
the mouse pointer carefully at the bottom right corner of the window, the shape of the pointer should change to one looking like an arrow pointing down and to the right. If you now hold down the left button you will be able to drag the bottom right corner of the window to a new position. This allows you to change the size and shape of the window. Just below the title bar is a menu bar typically holding items like File, Edit, Tabs and Help. If you place the pointer over the Edit item and press the left button, a menu will appear. Select the item named Preferences by highlighting it and press the left button. This will bring up a dialog box that allows you to modify various properties of the window, such as the background and foreground colours. I tend to prefer a background of darkish blue and a foreground of a light blue-green colour. Choose any colours you like but do not make them the same or your text will be invisible! You can create several LXTerminals by double clicking the LXTerminal icon several times. If you move them around you will nd some can be partially obscurred by others, just like pages of paper on a desk. To bring a window to the top, just place the mouse pointer anywhere on it and click the left button. This is said to also bring the window into focus which means that input from the keyboard will be directed at it. You can thus have several bash sessions running simultaneously, and you can move from one to another just by moving the mouse and clicking.
3.3
Midori
If you double click on the Midori icon, it will bring up a window containing the Midori web broswer. This allows you to follow links to almost any web page in the world. The only problem is to know what to type. If you happen to know the exact name (or URL) of the page you want to display, you can type it in carefully in the main text eld just below the Midori title bar. Such URLs normally start with http://www., for instance, try typing http://www.cl.cam.ac.uk/~mr10 and press Enter. This should bring up my Home Page. It is however usually easier to nd web pages by giving keywords to a search engine. Such keywords can be typed in the smaller text eld to the right of the main URL eld in Midori. But rst I would suggest you select Google as your search engine since this is my favourite. To do this click on the little icon at the left hand end of the text eld for keywords. This will bring up a menu of possible search engines, and you should click on Google. Now typing some keywords such as vi tutorial and press Enter. Google will respond with many links to web pages that relate to the keywords. Clicking on one of these will open that page. This is a good way to nd documentation and tutorials on almost any topic you are interested in. This particular request will help you with the vi editor briey summarised in the next section.
3.4. EDITING FILES
17
3.4
Editing Files
In order to program you are going to have to input and edit text les representing the programs you are going to write. There are many possible editor programs available for this but I will only mentions three of them. First is Leafpad mentioned above. It is easy to use but rather primitive and I do not recommend it for editing programs. The next is vi which is small, ecient and liked by a surprising number of professional programmers. It has good tutorials on the web, but the version typically installed on the Raspbery Pi has no built in documentation. My favourite text editor is called emacs. It is large and sophisticated and much liked by many professional (just as Linux is). It has plenty of build in documentation and is an eective editor even if you use only a tiny proportion of its facilities. The next two sections will give brief instructions on how to use vi and emacs.
3.5
vi
This section contains only a brief introduction to the vi editor since there are several excellent tutorials on vi some of which are videos. Try doing a web search on vi tutorial. Although I prefer to use the emacs editor, vi is sometime useful since it is a small program and simple to use. To enter vi, type the command vi filename where lename is the name of a le you wish to create or edit. If you omit the lename, you can still create a le but must give the lename when you write it to disc (using :w filename). When vi is running it displays some of the text of the le being edited in a window with with a ashing character indicating the current cursor position. The cursor can be moved using the arrow keys, or by pressing h, j, k or l to move the cursor left, down, up or right, respectively. vi has two modes: command and insert. When ininsert mode characters typed on the keyboard are inserted into the current le. Pressing the ESC character causes vi to return to command mode. In the description that follows text represents characters typed in in insert mode, ch represents a single character, Esc represents the escape key and Ret represents the Enter key. Some of the vi commands are as follows.
18 ^ $ i text Esc a text Esc o text Esc O text Esc J x X dd p u /text ?text n ZZ :wq Ret :q! Ret :w Ret :w filename Ret :s/pattern/replace/g Ret
CHAPTER 3. INTRODUCTION TO LINUX Move the cursor to the rst non blank character of the current line. Move the cursor to the end of the current line. Insert text just before the cursor. Insert text just after the cursor. Create a blank line just after the current line and insert text at its start. Create a blank line just above the current line and insert text at its start. Join the current line with the next one. Delete the character at the current cursor position. Delete the character before the current cursor position. Delete the current line putting it in the deletion buer. Insert (or paste) the text in the deletion buer to just before the cursor position. Undo the last command. Scan forwards from the current cursor position for the nearest occurence of text. Scan backwards from the current cursor position for the nearest occurence of text. Repeat the last / or ? command. Save the current le and exit from vi. Save the current le and exit from vi. Exit from vi without saving the le. Write the current le to disc. Write the current le to disc using the specied lename. Substitute all occurrences of pattern in the current line by replace. It g is omitted only the rst occurrence is replaced. Perform the substitution on all lines between line numbers n and m.The last line number can be written as $.
:n,ms/pattern/replace/g Ret
The vi editor has many more features, but the above selection is sucient for most needs.
3.6. EMACS
19
3.6
emacs
The emacs editor is highly sophisticated and much loved by many professional programmers and I recommend that you use it. You can use it eectively using a tiny minority of its available commands, and so it should not take long to learn. It is normally best to use emacs once you are in the graphics desktop, ie after you have executed the startx command immediately after logging in. So from now on I assume that you have started a graphics desktop session (using startx) and have opened an LXTerminal session, so that you can execute bash commands. The Linux image you copied to your SD card probably did not include the emacs editor, so you will have to install it using apt-get or synaptic. Try typing: sudo apt-get install emacs If this works (and it should), you will be able to enter emacs by typing emacs & This will create a new window on the desktop for emacs to run in. Before learning how to use emacs, I suggest you move to the next chapter and install the BCPL system. Once that is working come back here to see how to use emacs to edit les. You should rst set up some initialisation les so that emacs knows about BCPL mode which will automatically colour BCPL reserved words, strings, comments and other syntactic items appropriately. So, after installing BCPL, type: cd cp -r $BCPLROOT/Elisp . cp $BCPLROOT/.emacs . The next time you enter emacs, it will use BCPL mode when editing BCPL source les with extensions .b or .h. This makes BCPL source code much more readable. As I said above, you can create an emacs window by typing the emacs & command. When the window appears, move the mouse to it and click to bring it into focus. Input from the keyboard will now be directed to emacs. Many emacs commands require the Ctrl key to be held down. For instance, holding down Crtl and pressing e will move the cursor to the end of the current line. We will use the notation C-e to denote this operation. To illustrate what emacs can do, we will edit the hello.b program in the ~/distribution/BCPL/cintcode/com/ directory. To edit this le, type C-x C-f and then type ~/distribution/BCPL/cintcode/com/hello.b followed by Enter. This should put the following text (in colour) near the top of the window.
20 GET "libhdr" LET start() = VALOF { writef("Hello World!*n") RESULTIS 0 }
The cursor position will be marked by a small ashing rectangle. The cursor can be moved UP, DOWN, LEFT and RIGHT using the arrow keys. It can also be moved to the end of the current line by typing C-e, and to the beginning of the current line by C-a. Use these keys to position the cursor over the w of writef and press C-k C-k. The rst deletes (or kills) the text from the cursor position to the end of the line, and the second kills the newline character at the end of the line. The killed text is not lost but held in a stack of killed items. Type C-y will recover what has just been killed, and typing C-y again will recover it again. The text should now be as follows. GET "libhdr" LET start() = VALOF { writef("Hello World!*n") writef("Hello World!*n") RESULTIS 0 } Move the cursor to the w of the second writef and press the space bar twice will correct the indentation. Now move the cursor to the H of the second Hello World! and press C-d 12 times to delete Hello World!. Now insert some text by typing: How are you?. The text should now be as follows. GET "libhdr" LET start() = VALOF { writes("Hello World!*n") writes("How are you?*n") RESULTIS 0 } Now write this back to the le by typing C-s. To test that the editing was successful, click on the LXTerminal window and type: cat com/hello.b. It should output the edited version of the hello.b program. You can now compile and run it by typing:
3.6. EMACS cintsys c bc hello hello
21
The command c combines the le bc and the argument hello to form a command sequence that invokes the BCPL compiler to translate the source code com/hello.b into a form suitable for execution which it stores in cin/hello. You can inspect the source and compiled forms by typing the commands type com/hello.b and type cin/hello. Although at this stage the compiled form will be unintelligible. The le bc is called a command script and is one of many designed to make the BCPL cintcode system easier to use. Now return to the emacs window by clicking on it. We can move the cursor to the start of the le by typing C-Shift-Home and the end by C-Shift-End. Now move to the start of the le (C-Shift-Home). If we want to nd some text in the le type C-s followed by some characters such as al and observe how the cursor moves. You will see that the match ignores whether letters are in lower or upper case. If you press BkSp the cursor moves back to the a of start and pressing r will highlight the ar of start, and also the ar of are, two lines below. You can move to this word by either typing C-s again, or by increasing the length of our pattern by typing e. Pressing BkSp removes e from our pattern and returns the cursor to the just after the r of start. Just as C-s performs a forward search, C-r performs a backwards search. Practice using these commands until you are satised you can easily nd anything you want in the le. To leave this interactive searching mode press Enter. Suppose we wished to change every occurrence of writef to writes. We could do this by pressing C-Shift-Home to get to the top of the le. Then press Esc followed by % to enter the interactive replacement command. It will invite you to type in the text you wish to replace, namely writef. You terminate this by pressing Enter. It then invites you to give the replacement text, to which you type writes followed by Enter. This causes the rst occurrence of writef to be highlighted, waiting for a response. If you press the Space Bar it will replace this occurrence and move on to the next. If you press BkSp it will just move on to the next, and if you press Enter it will leave interactive replace mode. The command C-g aborts whatever you were doing and returns you to the normal editing state. This turns out to be more useful that you might imagine. A log of changes is kept by emacs and this is used by C- to undo the latest change. Multiple C- s can undo several changes. If you want to close the emacs window, type C-x C-c. Splitting the screen is useful if you want to edit two les at the same time. To do this type C-x 2 and to return to a single screen type C-x 1. C-x 3 will split the screen vertically putting the sub-windows side by side. There is a sophisticated online help facility. Type C-h to enter it. To nd out what to do next, type ?. This will split the window into two parts lling the lower
22
half with a decription of the possible help commands that are available. You can move the cursor into this sub-window by pointing the mouse into it and clicking. Alternatively, you can type C-x o. Once there, you can navigate through the help text using the same commands you use when editing a le. To obtain a list of all key bindings type C-h b. If you scroll down to Cx C-f (or search for it) you will nd it is bound to the find-file command. C-h f find-file will output a description of the command. Although the commands I have described so far allows you to create and edit les, you will nd exploring the emacs help system will allow you to use emacs even more eectively. More to follow
Chapter 4 The BCPL Cintcode System

The quick way to install the BCPL sytem is to download bcpl.tgz into your home directory (/home/pi) and then type the following sequence of commands. cd mkdir distribution cd distribution tar zxf ../bcpl.tgz cd BCPL/cintcode . os/linux/setbcplenv make clean make -f MakefileRaspi c compall cp -r Elisp $HOME cp .emacs $HOME -- to configure emacs -- to configure emacs
But if you wish to understand what is going on, you should read the next section. But, while your are here, you might as well install the BCPL Cintpos systems as well. To do this, download cintpos.tgz into your home directory and then type the following. cd mkdir distribution cd distribution tar zxf ../cintpos.tgz cd Cintpos/cintpos make clean make -f MakefileRaspi c compall 23
24
CHAPTER 4. THE BCPL CINTCODE SYSTEM
This is an interpretive implementation of the Tripos Portable Operating System which is described in the BCPL manual available from my home page.
4.1
Installation of BCPL
To install the BCPL System on the Raspberry Pi you must rst obtain a copy of the le bcpl.tgz which is available via my home page (www.cl.cam.ac.uk/users/mr). Near the top of this page, under the heading Shortcut to the main packages, you will nd a link to bcpl.tgz. Right clicking on this link should bring up a menu one of whose items will save bcpl.tgz as a le on your computer. If your Raspberry Pi is connected to the internet, you can do this using the Midori web browser and save to le in your home directory (/home/pi). Failing that, nd a computer that has an SD card slot and is connected to the internet, and copy bcpl.tgz into /home/pi on your SD card. When you next login to the Raspberry Pi you will nd bcpl.tgz in your home directory. To check it is there, run the following commands. pi@raspberrypi:~$ cd pi@raspberrypi:~$ pwd /home/pi pi@raspberrypi:~$ ls -l -rwxrwx--- 1 pi pi 10300397 Apr 23 15:20 bcpl.tgz pi@raspberrypi:~$ You can install BCPL anywhere you like but I would strongly recommend that the rst time you install it you place it in exactly the same location that I use on my laptop since this will allow you to set the system up without having to edit any of the conguration les. I therefore suggest you follow the next few steps exactly. 1) Create a directory called distribution, make it the current directory and decompress the tgz le into it. pi@raspberrypi:~$ mkdir distribution pi@raspberrypi:~$ cd distribution pi@raspberrypi:~/distribution$ tar zxvf ../bcpl.tgz --- Lots of output showing the names of all files of the BCPL system pi@raspberrypi:~/distribution$ 2) List the contents of the current directory, the BCPL directory and BCPL/cintcode.
4.1. INSTALLATION OF BCPL pi@raspberrypi:~/distribution$ ls BCPL pi@raspberrypi:~/distribution$ ls BCPL bcplprogs cintcode Makefile natbcpl README TGZDATE xfiles pi@raspberrypi:~/distribution$ ls BCPL/cintcode --- Lots of files and directories including g com sysb sysc os pi@raspberrypi:~/distribution$
25
3) Now change to directory BCPL/cintcode and type the following commands. pi@raspberrypi:~/distribution$ cd BCPL/cintcode pi@raspberrypi:~/distribution/BCPL/cintcode$ . os/linux/setbcplenv pi@raspberrypi:~/distribution/BCPL/cintcode$ make clean pi@raspberrypi:~/distribution/BCPL/cintcode$ make -f MakefileRaspi --- Lots of output showing the BCPL system being built --- ending with something like: bin/cintsys BCPL Cintcode System (24 Jan 2012) 0.000> The le os/linux/setbcplenv is a shell script that sets up BCPL environment variables such as BCPLROOT and BCPLPATH telling the system where BCPL has been installed. The important part of setbcplenv is as follows. export export export export export export export export BCPLROOT=$HOME/distribution/BCPL/cintcode BCPLPATH=$BCPLROOT/cin BCPLHDRS=$BCPLROOT/g BCPLSCRIPTS=$BCPLROOT/s POSROOT=$HOME/distribution/Cintpos/cintpos POSPATH=$POSROOT/cin POSHDRS=$POSROOT/g POSSCRIPTS=$POSROOT/s
export PATH=$PATH:$BCPLROOT/bin:$POSROOT/bin When run using the dot (.) command, it denes the required shell environment variables and updates the PATH variable to include the bin directories where cintsys and cintpos live. Cintpos is a portable operating system implemented
26
in BCPL but not covered by this document. You can test whether the script has run correctly by typing echo $BCPLROOT or printenv. You need to run this script every time you login to the Raspberry Pi if you want to use BCPL. It would therefore be useful for this to happen automatically every time you login. The bash shell runs some initialising shell scripts when it starts up, as is described in the manual pages generated by the man bash commands. Some of the scripts are provided by the system and live in the /etc directory but others live in the users home directory. The possible le names are .bash profile, .bash login, .profile and possibly .bashrc. You can see which of these dot les are in your home directory by typing: cd ls -a You should add the following line onto the end of one of these les. . $HOME/distribution/BCPL/cintcode/os/linux/setbcplenv On the version of Linux I am using on the Raspberry Pi, the script .profile calls .bashrc, and so I added the line to the end of the le .bashrc. To do this, I typed cd vi .bashrc This caused me to get into the vi editor editing the le .bashrc. Now using the down-arrow key several times I got to the last line of the le and typed the lowercase letter o. This got me into input mode allowing me to add text to the end of the le. I then typed the line . $HOME/distribution/BCPL/cintcode/os/linux/setbcplenv terminated by pressing both the Enter and Esc keys. This returned me to edit mode. Finally I typed: :wq and pressed Enter, to write the edited le back to the ling system. To check that I edited the le correctly, I typed cat .bashrc and looked carefully at its last line. After making this change to an appropriate script le, you should test it by logging out of the Raspberry Pi and login again. To logout, type sudo shutdown -h now
4.1. INSTALLATION OF BCPL
27
But, if you are in the graphics environment, you should leave this rst by clicking on the little red icon at the bottom right hand corner of the screen. The next time you login to the Raspberry Pi, you should nd that the BCPL environment variables have been dened automatically. To make sure, type: echo $BCPLROOT. The commands make clean and make -f MakefileRaspi remove unwanted les and causes the entire BCPL Cintcode System to be rebuilt from scratch. This involves the compilation of several C programs and the BCPL compilation of every BCPL program in the system. The last line 0.000> is a prompt from the BCPL Command Language Interpreter inviting you to type a command. If this all works you will now be in business and can begin to use BCPL. As conrmation that the system really is working, type in the following commands. 0.000> echo hello hello 0.000> type com/echo.b SECTION "ECHO" GET "libhdr" LET start() = VALOF { LET tostream = 0 LET toname = 0 LET appending = ? LET nonewline = ? LET text = 0 LET argv = VEC 80 IF rdargs("TEXT,TO/K,APPEND/S,N/S", argv, 80)=0 DO { writes("Bad argument for ECHO*n") RESULTIS 20 } IF argv!0 IF argv!1 appending nonewline DO DO := := text := argv!0 toname := argv!1 argv!2 argv!3 // // // // TEXT TO/K APPEND/S N/S
IF toname DO { TEST appending THEN tostream := findappend(toname) ELSE tostream := findoutput(toname)
28
CHAPTER 4. THE BCPL CINTCODE SYSTEM UNLESS tostream DO { writef("Unable to open file: %s*n", toname) result2 := 100 RESULTIS 20 } selectoutput(tostream) } IF text DO writes(text) UNLESS nonewline DO newline() IF tostream DO endstream(tostream) RESULTIS 0
} 0.260> bcpl com/echo.b to junk BCPL (1 Feb 2011) Code size 244 bytes 0.130> junk hello hello 0.020> bcpl com/bcpl.b to junk BCPL (1 Feb Code size Code size 1.210> junk 2011) 22156 bytes 12500 bytes com/bcpl.b to junk
BCPL (1 Feb 2011) Code size 22156 bytes Code size 12500 bytes 1.210> logout pi@raspberrypi:/distribution/BCPL/cintcode$ The echo command just outputs its argument. The type command outputs the BCPL source code of the echo command and the bcpl command compiles it into a le called junk. This is then executed as the junk command, demonstrating that it behaves exactly as the echo command did. Next we use the bcpl command to compile the BCPL compiler whose source code is in com/bcpl.b. This overwrites the le junk which is then used to compile the compiler again with identical eect. The prompt contains the time in seconds of the previous command, so we see that compiling the BCPL compiler takes a mere 1.2 seconds. The logout command
4.2. HELLO WORLD
29
leaves the BCPL system and returns to the bash shell. To re-enter the BCPL system type the command cintsys. If you plan to use the emacs editor (which I recommend) you should set up its initialisation les so that it knows about BCPL mode which will automatically colour BCPL reserved words, strings, comments and other syntactic items appropriately. To do this type: cd cp -r $BCPLROOT/Elisp . cp $BCPLROOT/.emacs . The next time you enter emacs it will used BCPL mode when editing BCPL source les with extensions .b or .h. This makes editing such les much more friendly. We will now look at a few more Linux commands. The bash program looks up commands in a sequence of directories called a path. This sequence can be inspected by looking at the value of the PATH environment variable as shown by: pi@raspberrypi:~$ echo $PATH /usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin: /home/pi/distribution/BCPL/cintcode/bin: /home/pi/distribution/Cintpos/cintpos/bin: You can output an entire le to the screen by commands such as cat com/echo.b or you can display it one page at a time using more as in more com/type.b. The more program can be controlled using the Space bar, Enter key, the arrow key, p and b and many others. To quit the program type q. The cp command copies les. For instance, cp com/abort.b prog.b will copy the source of the abort command into the current directory as le prog.b. You can also use cp to copy complete directory trees using the -r argument, as in cp -r g myg. You can test it worked by typing ls myg. The rm command removes les as in rm myg/libhdr.h. It can also remove complete directory trees using the -r argument, as in rm -r myg. We are now ready to learn how to program in BCPL and this will be done in a gentle way exploring the simple programs presented below.
4.2
Hello World
The BCPL system contains a huge number of BCPL programs that can be found in directories such as
30
CHAPTER 4. THE BCPL CINTCODE SYSTEM ~/distribution/BCPL/cintcode/com ~/distribution/BCPL/cintcode/sysb ~/distribution/BCPL/bcplprogs/demos ~/distribution/BCPL/bcplprogs/raspi The commands The system programs Some demo les The programs described here
You are certainly free to look at these, but it is probably best to start with some simple examples. Ever since Brian Kernighan wrote the rst Hello World program in an internal Bell Laboratory memorandum about B in the mid 1970s, it has become the standard rst program used in the description of most programming languages. The version for BCPL is com/hello.b and is as follows: GET "libhdr" LET start() = VALOF { writef("Hello World!*n") RESULTIS 0 } The line GET "libhdr" inserts a le declaring all sorts of library functions, variables and constants needed by most programs. The actual le inserted is cintcode/g/libhdr.h but there is no need to look at it yet. The next line is the heading of a function called start which, by convention, is the rst function of a program to be executed. The body of start is a VALOF block that contains commands to be executed terminated by a RESULTIS command that species the result. In this case a result of zero indicates that the hello program terminated successfully. But before returning, it executes writef("Hello World!*n") which output the characters Hello World! followed by a newline (represented by the escape sequence *n). This program can be compiled using the bcpl command to form a compiled program called junk which is then executed. 0.000> bcpl com/hello.b to junk BCPL (1 Feb 2011) Code size = 60 bytes 0.100> 0.000> junk Hello World! 0.020> Compiled commands are normally placed in a directory called cin, and, for convenience, there is a script called bc to simplify the compilation of such commands. If we regard hello.b as a command, it can be compiled using the c bc hello command as follows.
4.2. HELLO WORLD 0.030> c bc hello bcpl com/hello.b to cin/hello hdrs BCPLHDRS BCPL (1 Feb 2011) Code size = 60 bytes 0.130> The hello command can now be executed. 0.000> hello Hello World! 0.020> The script le bc is as follows #!/home/mr/distribution/BCPL/cintcode/cintsys -s .k file/a,arg echo "bcpl com/<file>.b to cin/<file> hdrs BCPLHDRS <arg>" bcpl com/<file>.b to cin/<file> hdrs BCPLHDRS <arg>
31
But at this stage there is no need to understand how it works. For convenience, all the BCPL programs covered in this document can be found in the the directory BCPL/bcplprogs/raspi of the standard BCPL distribution. If you make this your current directory, you can inspect, compile and run these programs using commands such as the following. pi@raspberpi:~$ cd ~/distribution/BCPL/bcplprogs/raspi pi@raspberpi:~/distribution/BCPL/bcplprogs/raspi$ cintsys BCPL Cintcode System (24 Jan 2012) 0.000> type hello.b GET "libhdr" LET start() = VALOF { writef("Hello World!*n") RESULTIS 0 } 0.020> c b hello bcpl hello.b to hello hdrs BCPLHDRS BCPL (1 Feb 2011)
32 Code size = 0.130> 0.000> hello Hello World! 0.020> 60 bytes
The command script b used here is similar to bc used earlier by expects the souce program to be in the current directory and place the compiled version in the same directory. The next program we will study concerns the Fibonacci sequence of numbers.
4.3
Fibonacci
Leonardo Fibonacci lived in Italy near Pisa dying in about 1250 AD aged around 80. He is regarded by some as the most talented western mathematician of the Middle Ages. He is perhaps best known for the sequence of numbers named after him. This sequence has some extraordinary properties and has excited mathematicians ever since. The sequence starts as follows: 0, 1, 1, 2, 3, 5, 8, 13, 21,... with every number being the sum of the preceding two. For instance 2+3 gives 5, and 3+5 gives 8 etc. These numbers can be given positions with the convention that the rst in the sequence is at position zero. The following table shows the positions and values of the rst few numbers in the sequence. position value 0 1 2 0 1 1 3 4 5 6 7 8 2 3 5 8 13 21
A program to print out the positions and values of some numbers in this sequence is called fib1.b and is shown in Figue 4.1. Text between // and the end of the line is called a comment and is designed to help the reader understand what is going on. Comments have no eect on the meaning of a program and are ignored by the compiler. This program can be compiled and run as follows. 0.020> c b fib1 bcpl fib1.b to fib1 hdrs BCPLHDRS BCPL (1 Feb Code size = 0.030> fib1 Position 0 Position 1 Position 2 0.010> 2011) 168 bytes Value 0 Value 1 Value 1
4.3. FIBONACCI GET "libhdr" LET start() = { LET a = 0 LET b = 1 LET c = a+b LET i = 0 VALOF // a and b hold two consecutive Fibonacci numbers
33
// c holds the Fibonacci number after b, namely a+b // The position of the Fibonacci number held in a Value %n*n", i, a)
writef("Position %n a := b b := c c := a+b i := i+1 writef("Position %n a := b b := c c := a+b i := i+1 writef("Position %n a := b b := c c := a+b i := i+1 RESULTIS 0 }
Value %n*n", i, a)
Value %n*n", i, a)
Figure 4.1: The le fib1.b At the beginning of the body of the function start we see the declaration LET a = 0. This allocates space in the memory of the computer which you can think of as a pigeon hole which can hold a number. It has the name a and is initialised with the number zero. Similarly, LET b = 1 allocates a pigeon hole for b initialised to 1. The third declaration LET c = a+b allocates a pigeon hole for c initialising it to the sum of the numbers in a and b. From now on, rather than talking about pigeon holes, we will usually describe them as variables with names a, b and c. They are called variables because, during the execution of the program, their values change. Indeed, as this program progresses, they are going to be successively set to three consective Fibonacci numbers further down the sequence. Initially, they hold the rst three Fibonacci numbers (0, 1, 1)
34
with a holding the number at position zero. The declaration LET i = 0 declares variable i to hold the position of the Fibonacci number in a. The statement writef("Position %n Value %n*n", i, a) outputs a line with the substitution items %n replaced by the numbers in variables i and a. It thus outputs the following. Position 0 Value 0
We now want to move on the the next position in the sequence, and so we set a and b to the values currently in b and c. This is done by the assignments a := b and b := c, being careful to do these assignments in that order. We then compute the new value of c using c := a+b which essentially says: take the numbers in variables a and b, add them together and put the result in c. The numbers now in a, b and c are the three consecutive Fibonacci numbers starting at position 1. To set i to this new position number, we execute the statement i := i+1 which increments i changing it from zero to one. The program then executes exactly the same code two more times, outputting the following: Position 1 Position 2 Value 1 Value 1
Finally, it executes RESULTIS 0 causing the program to return from start successfully. This program is not well written and can be improved in many ways. Its most obvious problem is that part of the program is written out three times and we should be able to nd a way of writing this part once, and somehow arrange for it to be executed three times. The following code does just this. GET "libhdr" LET start() = { LET a = 0 LET b = 1 LET c = a+b LET i = 0 VALOF // a and b hold two consecutive Fibonacci numbers // c holds the Fibonacci number after b, namely a+b // The position of the Fibonacci number held in a
WHILE i<=2 DO { writef("Position %n a := b b := c
Value %n*n", i, a)
4.3. FIBONACCI c := a+b i := i+1 } RESULTIS 0 }
35
Here the WHILE statement repeatedly executes its body so long as the value of i remains less than or equal to 2. This kind of loop is so common that many languages allow it to be coded even more compactly. Such as the following. { LET a = 0 // a and b hold two consecutive Fibonacci numbers LET b = 1 LET c = a+b // c holds the Fibonacci number after b, namely a+b FOR i = 0 TO 2 DO { writef("Position %n a := b b := c c := a+b } RESULTIS 0 } The FOR loop declares i with initial value 0, and then it repeatedly executes its body, incrementing i each time. This version is both more concise and more understandable. Finally, the variable c is only needed very briey when we are calculating the new value of b. We do not need to remember its value between iterations of the body, and so it can be declared inside the FOR loop. At the same time we can replace the separate declarations of a and b by a single simultaneous declaration. The resulting program is as follows. GET "libhdr" LET start() = VALOF { LET a, b = 0, 1 // a and b hold two consecutive Fibonacci numbers FOR i = 0 TO 2 DO { LET c = a+b // c holds the Fibonacci number after b, namely a+b writef("Position %n Value %n*n", i, a)
Value %n*n", i, a)
36 a := b b := c } RESULTIS 0 }
The declaration LET c = a+b is placed at the head of the block (enclosed within { } brackets) since such declarations are only permitted at the start of a block. An obvious advantage of this form of the program is that we can now easily change it to output the sequence up to, say, position 20. GET "libhdr" LET start() = VALOF { LET a, b = 0, 1 // a and b hold two consecutive Fibonacci numbers FOR i = 0 TO 20 DO { LET c = a+b // c holds the Fibonacci number after b, namely a+b writef("Position %n Value %n*n", i, a) a := b b := c } RESULTIS 0 } This gives the following output. 0.010> c b fib4 bcpl fib4.b to fib4 hdrs BCPLHDRS BCPL (1 Feb Code size = 0.020> fib4 Position 0 Position 1 Position 2 Position 3 Position 4 Position 5 ... 2011) 92 bytes Value Value Value Value Value Value 0 1 1 2 3 5
4.3. FIBONACCI Position Position Position Position Position Position 0.000> 15 16 17 18 19 20 Value Value Value Value Value Value 610 987 1597 2584 4181 6765
37
The nal improvement could be to arrange that the position numbers are printed in a eld width of 2 and the values in a eld width of, say, 12. We do this by changing the writef statement from writef("Position %n to writef("Position %2i The eect is as follows. Position Position Position Position Position Position ... Position Position Position Position Position Position 0 1 2 3 4 5 15 16 17 18 19 20 Value Value Value Value Value Value Value Value Value Value Value Value 0 1 1 2 3 5 610 987 1597 2584 4181 6765 Value %12i*n", i, a} Value %n*n", i, a}
We have just seen that we can perform quite complicated calculations just using simple variables, assignments, the plus operator and WHILE loops. If we allow subtraction as well, we can calculate almost anything we like, such as, for example, the nth prime number. A prime number is only divisible by 1 and itself. The rst few primes are 2, 3, 5, 7, 11 and 13. The following program outputs the 100th prime. GET "libhdr" LET start() = VALOF
38
{ LET n = 100 // The number of the prime we want LET p = 2 // The current number we are looking at LET count = 0 // The count of how many primes we have found { // Start of the main loop // Test whether p is prime // Let us assume it is prime unless proved otherwise LET p_is_prime = TRUE // Try dividing it by all numbers between 2 and p-1 FOR d = 2 TO p-1 DO { // d is the next divisor to try // We test to see if d divides p exactly LET r = p // Take a copy of p // Keep subtracting d until r is less than d UNTIL r < d DO r := r - d // If r is now zero, d exactly divides p // and so p is not prime IF r=0 DO { p_is_prime := FALSE BREAK // Break out of the FOR loop } } IF p_is_prime DO { // We have found a prime so increment the count count := count + 1 IF count = n DO { // We have found the prime we were looking for, // so print it out, writef("The %nth prime is %n*n", n, p) // and stop. RESULTIS 0 } } // Test the next number p := p+1 } REPEAT } This program uses special numbers TRUE (=-1) and FALSE (=0) to represent truth values. It uses an IF statement to conditionally execute some code, and it uses a BREAK command to break out of the FOR loop. The word REPEAT causes
4.3. FIBONACCI
39
the preceding command to be executed repeatedly. In this program the loop is terminated by RESULTIS 0 after the nth prime has been output. It is terribly inecient but it does compute the correct result on the Raspberry Pi in very little time, as can be seen below. 0.000> c b prime1 bcpl prime1.b to prime1 hdrs BCPLHDRS BCPL (1 Feb 2011) Code size = 124 bytes 0.110> prime1 The 100th prime is 541 0.080> If you successively change n to 1000, 2000 and 4000 you will nd the time to compute these primes increases by nearly a factor of 5 each time. It seems to grow faster than n2 (this stands for n n, so when n doubles the cost goes up by a factor of 4) but less fast than n3 (this stands for n n n, so every time n doubles the cost goes up by a factor of 8). Such programs are said to have polynomial complexity, and one of the challenges in programming is to nd ways of computing the required result much more eciently. If you think polynomial complexity is bad, exponential complexity is far worse (but sometimes useful). This is when the computation time grows at a rate of similar to k n (every time n is increased by 1 the cost goes up by a factor of k ). One problem that is thought to have exponential complexity is the following. Given an n digit decimal number, x say, that is known to be the product of two primes, nd them. In a sense this is easy just try dividing by every number between 2 and x 1. Unfortunately, there are roughly 10n to try and if n is more than about 500 it is likely to take longer than the life time of the universe to solve. Coming back to our nth prime program, we can speed it up quite a bit using additional operators available in BCPL, in particular the MOD operator that computes the remainder after division of one number by another. For instance 13 MOD 5 = 3. Using the MOD operator the program becomes: GET "libhdr" LET start() = VALOF { LET n = 100 // The number of the prime we want LET p = 2 // The current number we are looking at LET count = 0 // The count of how many primes we have found
40
CHAPTER 4. THE BCPL CINTCODE SYSTEM { // Start of the main loop // Test whether p is prime // Let us assume it is prime unless proved otherwise LET p_is_prime = TRUE // Try dividing it by all numbers between 2 and p-1 FOR d = 2 TO p-1 DO { // d is the next divisor to try // We test to see if d divides p exactly LET r = p MOD d // If r is zero, d exactly divides p // and so p is not prime IF r=0 DO { p_is_prime := FALSE BREAK // Break out of the FOR loop } } IF p_is_prime DO { // We have found a prime so increment the count count := count + 1 IF count = n DO { // We have found the prime we were looking for, // so print it out, writef("The %nth prime is %n*n", n, p) // and stop. RESULTIS 0 } } // Test the next number p := p+1 } REPEAT
4.4
Multiplication Table
The following simple program (bcplprogs/raspi/multab.b) outputs the 12x12 multiplication table. GET "libhdr"
4.5. A MATHEMATICIANS APPROACH LET start() = VALOF { FOR x = 1 TO 12 DO { newline() FOR y = 1 TO 12 DO writef(" %i3", x*y) } newline() RESULTIS 0 } The output it generates is as follows 1 2 3 4 5 6 7 8 9 10 11 12 2 4 6 8 10 12 14 16 18 20 22 24 3 6 9 12 15 18 21 24 27 30 33 36 4 8 12 16 20 24 28 32 36 40 44 48 5 10 15 20 25 30 35 40 45 50 55 60 6 12 18 24 30 36 42 48 54 60 66 72 7 14 21 28 35 42 49 56 63 70 77 84 8 9 10 11 12 16 18 20 22 24 24 27 30 33 36 32 36 40 44 48 40 45 50 55 60 48 54 60 66 72 56 63 70 77 84 64 72 80 88 96 72 81 90 99 108 80 90 100 110 120 88 99 110 121 132 96 108 120 132 144
41
Many will recognise this as the horrendous collection of 144 numbers one had to learn, often by rote, at school. Some readers will still be in the process of learning them. I have two reasons for giving this example. The rst is that this program can be easily modied to output tables for other expression operators. For instance, try replacing the expression x*y in the writef statement by each of x/y, x MOD y, x+y, x-y, x&y, x|y, x XOR y, and even x=y or x<y. All these operators are described later. The second reason is that learning 144 numbers can be boring and there are a whole collection of simple tricks that help you work out the answer to any of these multiplications.
4.5
A Mathematicians Approach
This section is entirely optional but the mathematics is contains is both simple and useful, so I recommend you only skip this section when you have had enough. Rather than remembering a multitude of results, mathematicians tend to like to work things out from rst principles. We all know that 5 9 = 45, but our memory is not always perfect and we might accidentally think 5 9 = 54 and have little to help us recognise that we have the wrong answer. A mathematician
42
looking 5 9 thinks of the cunning ways of multiplying by 5 and by 9. For instance, 9 = 10 1, so 5 9 = 5 (10 1) = 50 5 = 45. Since multiplication by 10 is easy as is subtracting 5, there can be little chance of error. Another , so 5 9 = 5 (8 + 1) = 5 8 + 5 = 10 4 + 5 = 45. thought is that 5 = 10 2 These are applications of two rules that I have named X9 and X5 and there are many other helpful rules as shown in Figure 4.2.
. Sq X1 X2 1 2 3 4 5 6 7 Sym 8 9 10 11 12 S1 2 4 6 8 10 12 14 16 18 20 22 24 3 6 9 12 15 18 21 24 27 30 33 36 S4 4 8 12 16 20 24 28 32 36 40 44 48 X5 5 10 15 20 25 30 35 40 45 50 55 60 6 12 18 24 30 36 42 48 54 60 66 72 7 14 21 28 35 42 49 56 63 70 77 84 8 16 24 32 40 48 56 64 72 80 88 X9 X10 X11 9 18 27 36 45 54 63 72 81 10 20 30 40 50 60 70 80 90 11 22 33 44 55 66 77 88
X12
12 24 36 48 60 72 84 96
99 108
90 100 110 120 99 110 121 132
96 108 120 132 144
Figure 4.2: Multiplication Table The rules are as follow. Sym We all know that 2 3 = 3 2 and 5 4 = 4 5, that is we can swap the order of the operands of the multiplication without changing the result. This rule can be stated algebraically as follow. xy =yx where x and y can be replaced by any numbers we like. The immediate eect of this rule is that we do not need to learn the 66 values in the bottom left triangle since they all appear in the upper right hand triangle. X1 The top row of the table is trivial since it corresponds to the one times table. Its entries, such as 1 5 = 5, are so obvious they hardly need to be learnt. The algebraic rule is as follows. 1x=x
4.5. A MATHEMATICIANS APPROACH X2
43
This corresponds to the two times table. It is easy to remember that 2 2 = 4. We have 5 ngers on each hand making 10 in all, so 2 5 = 10 is not a problem. We can surely remember that 2 10 = 20 and there are rules (X9, X11 and X12 to help with multiplication by 9, 11 and 12. So we really only have to learn 2 3 = 6, 2 4 = 8, 2 6 = 12, 2 7 = 14 and 2 8 = 16. The result of multiplying by two is called an even number and always has a 0, 2, 4, 6 or 8 in the units position, and so is easy to recognise. X10 Multiplication by ten is easy since it just requires a zero to placed on the end of the number, as is 10 6 = 60 or 10 12 = 120. We could possibly write this rule as follows. 10 x = x0 X11 Multiplication by eleven can be simplied by observing that 11 = (10 + 1), so that, for instance, 11 6 = (10 + 1) 6 = 60 + 6 = 66. The rule is thus: 11 x = 10x + x Notice that when x is a single digit, it is duplicated, as in 11 4 = 44, but when it is 10, 11 or 12 a simple addition is required, as in 11 10 = 100 + 10 = 110, 11 11 = 110 + 11 = 121 and 11 12 = 120 + 12 = 132. These are easy since no carries are required. X9 Multiplication by nine can be simplied by observing that 9 = (10 1), so that, for instance, 9 6 = (10 1) 6 = 60 6 = 54. The rule is thus: 9 x = 10x x X12 Multiplication by twelve can be simplied by observing that 12 = (10 + 2), so that, for instance, 12 6 = (10 + 2) 6 = 60 + 12 = 72. The rule is thus: 12 x = 10x + 2x Multiplying x by ten and two are trivial and adding the two results is easy because the units digit will be the units digit of 2x and the senior two digits will be the result of adding 0, 1 or 2 into the ten position of 10x, as in 12 7 = 70 + 14 = 84 or 12 9 = 90 + 18 = 108. X5 Computing 5 x can be simplied by observing that 5 = two versions depending on whether x is even or odd. If x is even it can be written as 2n and the rule is 5x=
10 2 10 . 2
The rule has
2n = 10 n
44
For example, 5 8 = 10 4 = 40 If x is odd it can be written as 2n + 1 and the rule is 5 x = 5 (2n + 1) = 10 n + 5 For example, 5 7 = 5 6 + 5 = 30 + 5 = 35 Sq Perfect squares are important and should be learnt. All except, 32 , 42 , 62 , 7 and 82 have been covered by rules given above. 32 = 9 is easy to remember since it is just three groups of three as in 123 456 789. 4 4 = 2 8 which equals 16 from the two times table. Observing that 6 = (5 + 1) suggests the 6 6 = (5 + 1) 6 = 5 6 + 6 = 30 + 6 = 36. 7 7 is a problem. Perhaps we should just remember that is is 49, or observe that 7 7 = 6 7+7 = 42+7 = 49. Finally 8 8 = 2 4 8 = 2 32 = 64. Since 8 is 23 , 82 = 26 and so is a power of two. Powers of two (1, 2, 4, 8, 16, 32, 64, 128, 256, . . . ) are important to computer scientists since computers use the binary system. These powers are etched into most computer scientists brains, as are 210 = 1024, 212 = 4096, 220 is about a million and 230 is about a thousand million.
2
S1 If you stare at the multiplication table long enough you will notice that 4 6 = 24 = 52 1 5 7 = 35 = 62 1 6 8 = 48 = 72 1 7 9 = 63 = 82 1 and so on. This is no accident because it follows from (x 1) (x + 1) = (x 1) x + (x 1) = x2 x + x 1 = x2 1 ie (x 1) (x + 1) = x2 1 So the product of two numbers that dier by two is one less that the square of the number between them. S4 The S1 rule can easily be generalised to ( x y ) ( x + y ) = x2 y 2 If we set y = 2 this becomes (x 2) (x + 2) = x2 4 as in 3 7 = 52 4 = 25 4 = 21 4 8 = 62 4 = 36 4 = 32
4.6. NUMBERS
45
This rule is not particularly useful but it does lead to one observation. The larger the value of y the smaller the product. So if you knew that 7 8 and 6 9 were 56 and 54, or possibly the other way round. Since 6 9 must be smaller than 7 8, 6 9 must have the smaller value, namely 54.
4.6
Numbers
The programs we have looked at so far involved numbers that were held in variables or named pigeon holes. This section explores how such numbers are represented within the computer. Humans have always used numbering systems based on 10, presumeable because we have 10 ngers. Even in the roman numbering system, 10 is special. For instance, single letters are used for 10 (X), 100 (C) and 1000 (M). Although the Roman numbering system is rather elegant and often used on clock faces (I, II, III, IV, V, VI, VII, VIII, IX, X, XI and XII) it is not convenient for numerical calculation. Consider, for example, adding 16 to 57. In roman numerals we would have to add XVI to DVII giving DXXIII (or 73). In China, India and the Arab world the advantages of multiple digits to represent numbers were well known 3000 years ago but not used in the west until much later. They also discovered the need for the digit zero which had previously not existed. Arithmetic calculations were sometimes done using pebbles placed in holes in the ground and the symbol 0 used to represent zero is thought to be a picture of a hole containing no pebbles. Fibonacci was one of the rst mathematicians in the west to study the advantages of the system we now use. We all know how to add 16 to 57. We rst add 6 to 7 giving the answer 3 in the units position and carry of 1 to the tens position. We then add this carry to 1 and 5 giving 7, resulting in the answer 73. Humans are happy with the idea of 10 digits (0 to 9) but computers are much easier to design if only two digits (0 and 1) are available. Typically, in electronic circuits, 0 is represented by a low voltage possibly about 0 volts, and one is represented by a higher voltage of possibly about 3 volts. Numbers using only the digits zero and one are binary numbers. They are like decimal numbers but their digit positions correspond to powers of 2 (1, 2, 4, 8, 16,...) rather powers of 10 (1, 10, 100, 1000,...) used in the decimal system. Using three digit binary numbers, we can count from 0 to 7 as follows: 000, 001, 010, 011, 100, 101, 110, 111. In BCPL, on the Raspbery Pi, numbers are represented using 32 binary digits (or bits) rather than the three just shown. So rather than just eight dierent numbers, a BCPL variable can have huge number of dierent values (actually rather more the 4000 million of them). This sounds like a lot and usually causes no problems. But if you write a program that requires numbers outside this range, unexpected things happen. For instance, if we modify the Fibonacci program
46
above to output Fibonacci numbers up to position 50 and modify the writef statements to be: writef("Position %2i Value %12u %32b*n", i, a, a}
The %12u substitution item outputs the Fibonacci number as an unsigned (ie >= 0) number in a eld width of 12 characters and %32b outputs it as a 32-bit binary number. The resulting output is: Position Position Position Position Position Position Position ... Position Position Position Position Position Position 0 1 2 3 4 5 6 45 46 47 48 49 50 Value Value Value Value Value Value Value Value Value Value Value Value Value 0 1 1 2 3 5 8 1134903170 1836311903 2971215073 512559680 3483774753 3996334433 00000000000000000000000000000000 00000000000000000000000000000001 00000000000000000000000000000001 00000000000000000000000000000010 00000000000000000000000000000011 00000000000000000000000000000101 00000000000000000000000000001000 01000011101001010011111110000010 01101101011100111110010101011111 10110001000110010010010011100001 00011110100011010000101001000000 11001111101001100010111100100001 11101110001100110011100101100001
Notice that the value at position 6 is 8 which is the sum of 3 and 5. In binary, the calculation is 0011+0101 giving 1000. The value at position 47 is correct, but after that the Fibonacci numbers are too large to be represented with just 32 bits, and digits o the left hand end are lost. This unfortunate eect is called overow and some languages generate a warning when this happens, but not BCPL. BCPL assumes that programmers are really clever and careful and dont need such warnings which, in any case, greatly complicates the denition of the language. We have seen that decimal constants such as 2 and 100 can be written in the normal way, but BCPL also allows binary constants by prexing a string of binary digits with #b, as in #b0011 and #b0101. It is sometimes helpful to put underscores in long numbers to make them more readable. For instance, the binary representation of the Fibonacci number at position 47 could be written as: #b1011_0001_0001_1001_0010_0100_1110_0001 This can also be written as a more concisely using the hexadecimal digits 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A, B, C, D, E and F, as follows: #xB11924E1
4.6. NUMBERS
47
Each hexadecimal digit represent 4 binary digits, so, for instance, #xB means #b1011 and #xB1 means #b10110001, etc. In binary numbers the values associated with the digits, taken from the right (or least signicant end) are 1, 2, 4, 8, 16,... or 20 , 21 , 22 , 23 , 24 , . . .. Following this convention the left most bit of a 32-bit binary number corresponds to the value 231 which is, of course, a positive number. Unsigned numbers use this convention, but if we want to represent positive and negative numbers, the normal convention to use is to assign a value of 231 to the left most bit. This allows us to have numbers roughly in the range -2000 million to +2000 million. Notice that #x80000000 represents the largest negative number, #xFFFFFFFF represents the number -1 and #x7FFFFFFF represents the largest positive number. The representation of -1 perhaps needs some explanation. With a decimal numbers such as 9999, we all know how to increment it by one. During the calculation there is a cascade of carries before producing the answer 10000. So a string of consecutive nines on the right are converted to zeroes. A similar cascading eect happens when we increment a binary number having a sequence of ones on the right. Just as nine is the largest decimal digit, one is the largest binary digit, so when incrementing the digit one it turns into a zero and generates a carry. If we add one to the binary number 1111, there is a cascade of carries before giving the result 10000. If we add one to the binary number consisting of a zero bit followed by 31 ones (#x7FFFFFFF) we get a one followed by 31 zeroes (#x80000000). In unsigned arithmetic this correctly represents the value 231 . In signed arithmetic, this result represents 231 and so the calculation has overowed, so #x7FFFFFFF must be the largest positive number than can be represented. If we increment a bit pattern of 32 ones (#xFFFFFFFF), using signed arithmetic, all the least signicant ones are turn to zeroes and the left most bit also changes from a one to a zero. This gives the correct answer since the carry into the left most bit represents 231 and this cancels the one that is there representing 231 correctly giving a zero bit in this position. Thus adding one to #xFFFFFFFF gives zero, and so #xFFFFFFFF must represent 1. We have already seen the operators +, - and MOD used in programs given above, but several other expression operators available. The operator * will multiply its operands together as in 3*7 gives 21. The operator / divides its left hand operand by the one on the right, as in 13/5 gives 2. Notice that the result is a whole number and the remainder, if any, is thown away. The remainder after division can be obtained using the MOD operator, as in 13 MOD 5 which gives 3. If we do ordinary arithmetics using operators like +, - and * but always return the remainder after division by some number, often called the modulus, then we are doing what is called modulo arithmetic. We will see useful applications of modulo arithmetic later. A value can be negated using - as a monadic operator, as in -x. If x was 1000 then the result would be -1000. The monadic operator ABS negates its operand if it was negative, but leaves it unchanged if it was positive. Thus, ABS (-1000)
48
and ABS 1000 both give 1000. There are various operators that maniplulate bit patterns directly. For instance, x<<n will shift the value of x left by the number of bits specied by n. Bits are lost o the left hand end and vacated positions on the right are lled with zeroes. The expression x>>b similarly computes x shifted right by n bit positions, lling vacated positions with zeroes. The operators & and | perform the logical bit-wise operations of and and or. For and, the nth bit of the result is only a one if the nth bit of both operands are ones, as in #b0011 & #b1010 gives #b0010. For or, the nth bit of the result is only a zero if the nth bit of both operands are zeros, as in #b0011 | #b1010 gives #b1110. The monadic operator ~ complements each bit of its operand to give the result. You might like to convince yourself that (~x)+1 = -x. The XOR operator computes a result in which the nth bit is only a one if the corresponding bits of its two operands are dierent, as in #b0011 & #b1010 gives #b1001. Two little tricks are worth noting. If we subtract one from a variable x we get a bit pattern identical to x except the consecutive zero bits on the right have all changed to ones, and the rightmost occurring one has changed to a zero. If we then and this with the original value of x we obtain a bit pattern with the right most occurring one removed. For example: x x-1 x & (x-1) 0101_1101_0011_1010_0000_0110_0000_0000 0101_1101_0011_1010_0000_0101_1111_1111 0101_1101_0011_1010_0000_0100_0000_0000
Similarly, if we compute x & (-x), we obtain a bit pattern which is all zeroes except for a one in the position of the right most one in x. For example: x -x x & (-1) 0101_1101_0011_1010_0000_0110_0000_0000 1010_0010_1100_0101_1111_1010_0000_0000 0000_0000_0000_0000_0000_0010_0000_0000
Many other bit manipulations require cunning to do eciently. For instance, how can we nd the most signicant occurring one, or count the number of ones in a bit pattern. If you are interested in these kinds of problems look at the programs in bcplprogs/bits.
4.7
Applications of XOR and MOD
If you do not feel up gives the remainder after to it, skip this section and the next, but, trust me, you might nd it interesting. Cryptography is the science of encoding secret messages is a way which allows only the intended recipient to decode them. Many methods involve
4.7. APPLICATIONS OF XOR AND MOD
49
the use of a shared secret key known by both the sender and receiver but unknown to everyone else. Suppose the sender and receiver agree that the shared secret key is the 32 bit word #x87654321 and the message to be sent is #x0ABCDEF0. The sender could encode the message using the XOR operator to combine the key with the message to give the encrypted message #x8DD99DD1 (= #x87654321 XOR #x0ABCDEF0). This has complemented some of the bits in the binary representation of the message, and the receiver can complement the same bits by computing #x87654321 XOR #x8DD99DD1, giving back the original message #x0ABCDEF0. To anyone not knowing the secret key, the encoded message #x8DD99DD1 is meaningless. This is potentially the basis of an excellent encryption technique but it suers the major problem of how we setup the secret keys between everyone who wishes to encrypt their messages. You cannot send a key unencrypted since an eavesdropper will be able to see it, and you cannot send it encrypted because we have assumed you have no secret key already set up. You could possibly hand it over in person, by telephone or by post, but these methods take time a may be inconvenient. A better solution must be found. It was not until 1978 that a suitable mechanism, called RSA public-key encryption, was invented (named after the developers Rivest, Shamir and Adleman). The idea is simple. The receiver publishes a key that everyone can read. The sender uses this key to encode the message and sends it to the receiver. The way the message is encoded is such that it cannot be decoded using the public key but requires an additional secret known only by the receiver, the person that published the public key. The public key consists of two carefully chosen random numbers r and e. To encode a message M, assumed to be less than r, we compute Me (ie 1 multiplied by M, e times) and then take the remainder after division by r. If we call this encrypted value C, then C = Me mod r Although this calculation looks horrendous, it is, in fact, quite easy to do, as shown in page 63. Knowing the public key is not enough to decode the encrypted message. However, there is a decoding exponent d that was calculated and kept secretly by the receiver when the public key of r and e was chosen. This can be used to decode the encryted message M by evaluating the following: Cd mod r As an example, if the receiver chose a public key of r=1576280161 and e=10000691, and a decoding exponent of d=899015831, the calculations would be as follows. #x0ABCDEF010000691 mod 1576280161 gives #x5AF3EBFE and #x5AF3EBFE899015831 mod 1576280161 gives #x0ABCDEF0
50
This gives the correct result, and since only the receiver knows the decoding exponent, no one else can (easily) decode the message. To see how the above calculations were done, look as the le bcplprogs/crypt/rsa.b. The next section (which may be skipped) gives a brief introduction to the underlying mathematics associated with RSA encryption.
4.7.1
RSA Mathematical Details
This section is entirely optional and should only be read by those who are interested. It shows how the public key and decoding exponent can be chosen, but does not go into the details of why the mechanism works. In practice, the public key should be rather large, perhaps 2000 bits in length or more. So all arithmetic must be done using numbers of this size rather than the 32 bits used in the previous section. To create a new public key, rst think up two large prime numbers p and q that are roughly equal and whose product is about 2000 bits long. Unfortunately nding such large primes is out of the scope of this document. Now multiply p by q to give the rst component of the public key. Next choose a number e that is about the same size as p, and check that it has no factors in common with (p-1)*(q-1). This is extremely likely to be true if e is a prime. If the test succeeds e is the second component of the public key, otherwise keep trying other values for e. Now nd the decoding exponent by nding d such that (e * d) = 1 modulo (p-1)*(q-1) This amounts to calculating d = 1/e using arithmetic modulo (p-1)*(q-1). This can be done using a program related to Euclids greatest common devisor (GCD) algorithm. The public key used in the previous section was based on the prime numbers p=45007 and q=35023. Their product was 1576280161 and the chosen encoding exponent was 10000691. The expression (p-1)*(q-1) evaluates to 1226540484, and (1/e) modulo 1226540484 gives 899015831, the decoding exponent. Notice that if you can factorise the rst component of the public key into its two prime factors p and q, you would be able to calculate the decoding exponent d and so would be able to decode any message using this public key. Luckily factorising such large numbers is thought by most mathematicians to be unfeasible. This is only the germ of the idea of public key encryption. For a professional version much attention must be paid to subtle details of the implementation and use.
4.8. VECTORS
51
4.8
Vectors
We have already seen that variables are like named pigeon holes that contain numbers, and that they can be declared by declarations such as LET x, y, z = 5, 36, 1004 To implement this declaration, BCPL nds three pigeon holes that are currently free, labels them with the names x, y and z, and puts the numbers 5, 36, 1004 into them. The BCPL Cintcode system normally has about 4 million pigeon holes to choose from, and each is labelled with an identifying number, similar to the way houses have numbers. Such numbers help postmen deliver letters, and pigeon hole numbers turn out to be fantastically useful in BCPL programs. The pigeon hole numbers of variables x, y and z can be found using the @ operator, as in the following program. GET "libhdr" LET start() = VALOF { LET x, y, z = 5, 36, 1004 writef("@x=%n @y=%n @z=%n*n", @x, @y, @z) RESULTIS 0 } The following shows this program being compiled and run. 0.000> c b vec1 bcpl vec1.b to vec1 hdrs BCPLHDRS BCPL (1 Feb 2011) Code size = 80 bytes 0.030> 0.000> vec1 @x=12156 @y=12157 @z=12158 0.000> Notice that the pigeon hole numbers for variables x, y and z are consecutive. This is no accident since BCPL always allocates consecutive pigeon holes to variables declared by simultaneous declarations. Pigeon hole numbers are normally called addresses and the symbol @ was chosen because it looks like an a inside an o standing for address of.
52
Instead of using the name x to access the contents of its pigeon hole we can use the indirection operator (!) applied to the pigeon hole number. So if @x evaluates to 12156, then !12156 would behave exactly like x. We cannot tell in advance what the address of x will be, so it would be better to declare another variable p, say, to hold this value. The expressions !p, !(p+1) and !(p+2) are now equivalent to x, y and z. Since expressions like !(p+1) and !(p+2) are so useful, a dyadic version of the ! operator is provided allowing these expressions to be written as p!1 and p!2, as is shown in the following example. GET "libhdr" LET start() = VALOF { LET x, y, z = 5, 36, 1004 LET p = @x p!2 := p!0 + p!1 // Equivalent to z := x + y writef("x=%n y=%n z=%n*n", x, y, z) RESULTIS 0 } The output from this program is as follows. x=5 y=36 z=41 Collections of consecutive pigeon holes are called vectors in BCPL. In other languages, they are often called one dimensional arrays. They are sometimes used to represent values that are too large to t into a single BCPL word. An example is BCPLs representation of the current time and date as shown in the following program (vec3.b). GET "libhdr" LET start() = VALOF { LET days, msecs, filler = 0, 0, 0 datstamp(@days) writef("days=%n msecs=%n filler=%n*n", days, msecs, filler) // Output the time in hh:mm:ss.mmm format writef("The time is %2i:%2z:%2z.%3z*n", msecs/(60*60*1000), // The hours msecs/(60*1000) MOD 60, // The minutes msecs/1000 MOD 60, // The seconds msecs MOD 1000) // The milli-seconds RESULTIS 0 }
4.8. VECTORS
53
We can run this program vec3 immediately followed by the command dat msecs separating by a semicolon (;) giving the following output. 0.010> vec3; dat msecs days=15502 msecs=38273016 filler=-1 The time is 10:37:53.016 Monday 11-Jun-2012 10:37:53.020 0.000> The argument given to the library function datstamp is the address of the rst of three consecutive variables named days, msecs and filler to hold a representation to the current time and date. After the call, days holds 15502 being the number of days since 1 January 1970, and msecs holds 38273016 being the number of milli-seconds since midnight. To demonstrate this number is correct, it has been converted to hours, minutes and seconds and compared with the output of the dat command. By the way, dat stands for date and time. Historically, datstamp was dened when BCPL was typically used on 16-bit computers such as the PDP-11, Data General Nova or the Computer Automation LSI-4. When BCPL words were only 16 bits long three words were need to represent the date and time. For compatibility with the past three words have been retained with the convention that -1 in filler indicates that the new representation is being used. It is all very well declaring vectors using simultateous declarations, but this method is not feasible if we wish to declare a vector containing 1000 elements, or if we do not know how many elements we need until the program is running. The declaration LET v = VEC 10 declares a variable v initialised with the address of 11 consecutive pigeon holes. They can be accessed by expressions such as v!0, v!1 up to v!10. The operand of VEC, in this case 10, is the upperbound of the vector and must be a compile time constant. The elements of v are unnamed and so can only be access using the subscription operator (!). Vectors declared using = VEC are allocated from and area of memory called the run time stack which is of limited size (typically 50000 words), so if you require vectors larger than about 1000 elements, or if you do not know how large they should be until the program is running, you should allocate them using getvec. This function has one argument which is the upperbound of the vector required and it returns the address of its zeroth element, or zero if insucient space is available. Vectors allocated by getvec should be freed by calls of freevec otherwise space will be permanently lost. This is often called a space leak as illustrated by the following program (vec4.b). GET "libhdr"
54
LET start() = VALOF { LET v1, v2 = 0, 0 v1 := getvec(100_000) writef("getvec(100_000) => %n", v1) v2 := getvec(3_000_000) writef("getvec(3_000_000) => %n", v2) IF v1 DO freevec(v1) //IF v2 DO freevec(v2) // Forget to free v2 RESULTIS 0 } The eect of running this is as follows.
0.030> vec4 getvec(100_000) => 62171 getvec(3_000_000) => 162181 0.010>
The state of memory can be inspected using the command map pic, as follows:
0.010> map pic Largest contiguous free area: 837810 words Totals: 4000000 words available, 3012122 used, 987878 free
0 200064 400128 600192 800256 1000320 1200384 1400448 1600512 1800576 2000640 2200704 2400768 2600832 2800896 3000960 3201024 3401088
@@@@a...............................................a@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a........... ................................................................ ................................................................
4.9. PRIMES
3601152 3801216 0.000>
55
................................................................ ................................................................
This shows that the 3 million words allocated for v2 have not been freed, so the next time vec4 is executed it is unable to allocate v2.
0.000> vec4 getvec(100_000) => 62171 getvec(3_000_000) => 0 0.010>
An advantage of declaring a vector using = VEC is that it is automatically freed when execution leaves the block in which it was declared. On page 36 we saw how to write out some Fibonacci numbers. We will now look at a program lls a vector with them. GET "libhdr" LET start() = VALOF { LET f = VEC 50 // A vector to hold Fibonacci numbers from 0 to 50 f!0 := 0 // Fill in the first two Fibonacci number f!1 := 1 // Now fill in the others FOR i = 2 TO 50 DO f!i := f!(i-1) + f!(i-2) // Now write out the result FOR i = 0 TO 50 DO writef("Position %2i Value %12u RESULTIS 0 } It produces exactly the same output that we saw on page 46.
%32b*n", i, f!i, f!i)
4.9
Primes
As another example of the use of vectors, we will look a a program that nds all prime numbers less than a million. The program is as follows.
56 GET "libhdr"
LET start() = VALOF { LET upb = 1_000_000 LET isprime = getvec(upb) FOR i = 2 TO upb DO isprime!i := TRUE // Until proved otherwise.
FOR p = 2 TO upb IF isprime!p DO { LET i = p*p // First non prime to be crossed out // Cross out all multiple of p IF i>upb BREAK { isprime!i := FALSE; i := i + p } REPEATUNTIL i>upb } // Output some primes near the end FOR p = upb-100 TO upb IF isprime!p DO writef("%6i*n", p) freevec(isprime) RESULTIS 0 } This program outputs the primes between 999900 and a million. 0.000> vec6 999907 999917 999931 999953 999959 999961 999979 999983 0.200>
4.10
MANIFEST, GLOBAL and STATIC declarations
We have already seen how to declare local variables and vectors using LET, but there other ways to declare variables. The rst of these is the MANIFEST declaration as in:
4.10. MANIFEST, GLOBAL AND STATIC DECLARATIONS MANIFEST { col_red = #xFF0000 col_green = #x00FF00 col_blue = #x0000FF n_op=0 n_r1 n_r2 // The operator field of a node // The first operand field of a node // The second operand field of a node
57
// List of node operators s_num=1 // A number node s_mul // A multply node s_div // A divide node s_add // An add node s_sub // A subtract node } This declaration declares various named constants such as col red and n op. If the name being declared is followed by an equal sign (=) then its value is that of the constant following the equals, otherwise its value is one larger than that of the previous name declared. Thus n r1 and b r2 have values 1 and 2. The GLOBAL vector is a area of memory that is allocated when a program starts and usually has an upperbound of 1000. It is possible to give names to particular elements of the global vector and this is done using a GLOBAL declaration. The following example is a modication of part of the standard library header le g/libhdr.h. GLOBAL { globsize: start: stop: sys: clihook: muldiv: changeco: currco: colist: rootnode: result2 returncode cis
0 1 2 3 4 5 6 7 8 9
//SYSLIB //SYSLIB //SYSLIB
MR 18/7/01 changed to G:5 MR 6/5/05 MR 6/5/04
// For compatibility with native BCPL
58 cos }
It declares that globsize is a variable at position zero of the global vector. By convention it holds the upper bound of the global vector which is usually 1000. This can be conrmed by executing writef("globsize=%n*n", globsize). The next variable is called start and is by convention is the rst function of a program to be called. The variables result2, returncode, cis and cos are not followed by colons (:) and so are given successively the next available global positions, namely 10, 11, 12 and 13. The main advantage of global variables is that they provide a means of communication between separately compiled parts of the system. For instance, there is a precompiled library module called blib that contains the denitions of functions like writef that we have used in all the example programs so far. The entry point to writef actually resides in global 94 and is initialise at the moment a program starts. STATIC declarations have a similar syntax to MANIFEST declarations but declare initialised variables rather than constants. Unlike manifest constants they can be updated using assignment statements. An example is as follows: STATIC { a=1 b c } This will declare three static variables a, b and c initialised to 1, 2 and 3. In general static variables should not be used unless absolutely necessary. They are usually better placed in the global vector.
4.11
Functions
We have already used functions several times. For instance, we have dened the function start in every program and we have used functions such as writef, datstamp, getvec and freevec several times. In this section we examine functions in more detail. Sometimes we have a fragment of code that we would like to use in several dierent places. It would therefore be good to have a simple way on executing that code without having to write the entire fragment on each time. In most programming languages this can be done by wrapping up the code in something called a function. As an example we will look as the denition of the library
4.11. FUNCTIONS
59
function randno which generates a sequence of pseudo random numbers. Its denition is as follows. LET randno(upb) = VALOF { // Return a random number in the range 1 to upb randseed := randseed*2147001325 + 715136305 RESULTIS (ABS(randseed/3)) MOD upb + 1 } This declares the function randno whose entry point is held in global variable 34 as declare in libhdr.h. Within its body it refers to randseed which is declared as global 35. The function is an implementation of what is called a congruential random number generator with carefully chosen constants 2147001325 and 715136305 to cause it to cycle though a huge number of apparently random values. The use of ABS, division by 3, MOD and +1 remove some of the deciencies of the randseed sequence and restrict the resulting numbers to the required range of 1 to upb. Each value in this range should occur with equal likelihood. There are two things to note about function denitions. Firstly, if the name of the function is already declared as a global then its entry point becomes the initial value of that global. Secondly, every variable used inside a function must either be declared inside that function or be declared by a function, MANIFEST, GLOBAL or STATIC declaration. Thus so called dynamic free variables are not allowed. To avoid this problem, never dene a function inside another. (This is enforced syntactically in languages like C). You can pass a collection of values to a function when you call it. These are called arguments and they are enclosed in round brackets (( and )). We have already seen this done in calls like writef("x=%n y=%n z=%n*n", x, y, z). Here we are calling the function writef giving it four arguments. The rst is a string (actually represented by a pointer to the characters of the string), and the remaining ones are the values of x, y and z. When a function is declared it is given a list of names enclosed in round brackets and separated by commas. These names behave just like local variables that have been initialised from left to right with the argument values. The declaration of writef is in the le sysb/blib.b and its rst line is: LET writef(format,a,b,c,d,e,f,g,h,i,j,k,l,m, n,o,p,q,r,s,t,u,v,w,x,y,z) BE As can be seen, its rst argument is called format to hold the format string given in the call. The remaining 26 arguments are initialised to as many arguments as were supplied in the call. Hopefully no one will call writef with more than this number of arguments. If they do the later arguments will be lost. Just
60
as simultaneously declared local variables live in adjacent pigeon holes, the same applies to function arguments. So, for instance, the arguments a to z can thought of as a vector of 26 elements pointed to by @a, and so can be accessed conveniently as needed within the declaration of writef. Functions taking variable numbers of arguments are often called variadic functions. They are clearly useful but often dicult to implement sensibly in other languages. The word BE in the declaration of writef indicates that its result is undened and that its body is not an expression but a command or command sequence. After all, writef is not designed to compute a value since its purpose is to output some formatted text. Functions designed to compute results are declared using = in place of BE, and after the equal sign there is an expression (not a command). A simple example is the denition of the factorial function that computes 1 2 3 . . . n for a given argument n. Its denition is as follows: LET fact(n) = n=0 -> 1, n*fact(n-1) The expression n=0 -> 1, n*fact(n-1) is an IF-THEN-ELSE construct for expression. It computes the condition, in this case n=0, and if the result is non zero (representing TRUE) it returns the rst alternative namely 1, otherwise it returns the result of evaluating n*fact(n-1). The interesting thing about this denition is that it is recursive, dening fact in terms of its self, based on the idea that factorial 0 is 1 and for non zero n factorial of n is n factorial of n 1. Another example is a rather beautiful denition of a function to compute Fibonacci numbers. The following program outputs them up to position 50. GET "libhdr" LET fib(n) = n=0 -> 0, n=1 -> 1, fib(n-1) + fib(n-2) LET start() = VALOF { FOR i = 0 TO 50 DO writef("Position %2i RESULTIS 0 } When you run this program it takes longer and longer to output each line, and if you time it with a stopwatch, each line take a time approximately proportional to the value of the Fibonacci number it is printing. On my laptop it takes about
Value %12u*n", i, fib(i))
4.12. SOLVING THE RECURRENCE RELATION FOR C
61
2 hours to output all 51 Fibonacci numbers and, although I have not tried, I would expect it to take about 8 times longer on the Raspberry Pi. It is perhaps interesting to explore why this wonderfully elegant little program is so inecient. Let us try and dene a cost function C (n) that is the cost (in time) of computing fib(n). When n is 0 or 1 computing fib(n) is very cheap. Let us arbitrarily say the cost of computing fib(0) is so small it can be zero and the cost of computing fib(1) is one unit. For larger values of n the cost is dominated by the cost of computing fib(n-1) and fib(n-2) giving a total of C (n 1) + C (n 2). So we have dened the cost function C to have the following properties. C (0) = 0 C (1) = 1 C (n) = C (n 1) + C (n 2) when n > 1 This recurrence relation gives us exactly the same sequence of values as the Fibonacci sequence itself which explains why the time to output each line is approximately proportional to the Fibonacci number being written. In the next section (which is entirely optional) we will obtain a simple formula for C (and indeed fib(n)).
4.12
Solving the recurrence relation for C
In this section we explore the peculiar way in which mathematicians think. They are typically extremely optimistic, thinking they can solve apparently unsolvable problems. They are persistent, repeatedly trying dierent approaches when all earlier attempts have failed, and they have usually acquired reasonable skill in algebraic manipulation. To solve this problem, a mathematician checks whether C (n) grows as fast as n2 or n3 but soon discovers that it grows much faster. Indeed it looks as if it grows faster than nk for any k . Oh dear, we must nd a formula that grows faster than any of these. How about X n ? So lets try C (n) = X n . This clearly is not right, but lets try it all the same. When n is large, substituting this in our denition of C (n) gives us X n = X n1 + X n2 . Assuming X is not zero we can divide both sides of the equation by X giving X n1 = X n2 + X n3 and if we repeatedly divide by X we eventually get the beautifully simple equation X 2 = X + 1. If we rearrange this to be X 2 X = 1 and then add 1/4 to both sides we get X 2 X + 1/4 = 1 + 1/4 = 5/4. We can now take the square root of both sides giving X 1/2 = 5/2. So possible values of X are (1 + 5)/2 and (1 5)/2. The rst of the has a value of about 1.618 and is so famous it is called the Golden Ratio. Look it up on the Web to see why it is so important. The second value is approximately -0.618. If we call these two values and , we can convince ourselves that a mixture of the two such as An + B n also satises
62
the relation, and by choosing suitable values for A and B , we can make a simple formula match C (n) exactly. Substituting n equals 0 and 1 in our denition of C (n) we get C (0) = A0 + B 0 = A + B = 0 and C (1) = A + B = 1. The rst equation tells us that B = A, and substituting equation this in the second gives A( ) = 1. Remembering that = (1 + 5) / 2 and = (1 5)/2 we can easily deduce that A = 1/ 5. The formula for C (n) is thus C (n) = (n n )/ 5. or C (n) =
(1+ 5)n (1 5)n . n 2 5
As a challenge, convince yourself that this yields a whole number for every n even though this formula contains 5 three times.
4.13
Greatest Common Divisor
The greatest common divisor (the GCD) of two positive numbers is the largest number that exactly divides into both of them. For instance the GCD of 18 and 30 is 6. In roughly 200 BC, Euclid divised an ecient way of computing it. It is essentially as follows. If they are equal that is the answer, otherwise replace the larger number by the remainder of dividing it by the smaller number, repeating the process until both numbers are equal. A BCPL implementation of this is as follows: GET "libhdr" LET gcd(a, b) = VALOF { LET r = a MOD b // r will be less than b IF r=0 RESULTIS b // b exactly divides a so is the gcd // r and b have the same gcd as a and b a := b b := r // a is greater than b } REPEAT LET try(a, b) BE { LET res = gcd(a, b) writef("gcd(%n, %n) = %n*n", a, b, res) }
4.14. POWERS LET start() = VALOF { try(18, 30) try(1000, 450) try(1576280161, 1226540484) } This gives the following output. gcd(18, 30) = 6 gcd(1000, 450) = 50 gcd(1576280161, 1226540484) = 1
63
Notice that if b is greater than a initially, then the rst iteration of the REPEAT loop just swaps these variables.
4.14
Powers
Another example worth looking at is how to raise a number to a large power using modulo arithmetic. That is how can we calculate xn modulo m eciently as is required by the RSA mechanism described above. Two ideas come to mind. One is that when we want to calculate, say, 1234 5678 modulo 100, we need only consider the two least signicant digits of each number, since the others cannot aect the answer. So calculating 34 78 modulo 100 gives the same result. This generalises to a b modulo m gives the same result as ((a modulo m) (b modulo m)) modulo m. The other idea is to consider the binary representation of the exponent. For instance, if we want to calculate 725 , we observe that 25 is 11001 in binary corresponding to 16 + 8 + 1 so multiplying 1 by 7, 25 times is the same a multiplying 1 by 7, 16 times, then multiplying by 7, 8 times and nally multiplying by 7 once more. In mathematical notation this is just saying 725 = 716+8+1 = 1 716 78 7. We can easily calculate 72 , 74 , 78 and 716 since 72 = 77, 74 = 72 72 , 78 = 74 74 , etc. Based on these ideas we can construct an elegant program that compute xn modulo m, such as the following. LET powmod(x, n, m) = VALOF { LET res = 1 LET p = x MOD m WHILE n DO { IF (n & 1)=0 DO res := (res * p) MOD m n := n>>1
64 p := (p*p) MOD m } RESULTIS res }
This program has two disadvantages. One is that it is using signed arithmetic and secondly it has a problem with overow and so only works with quite small numbers. A version using full 32-bit unsigned numbers is as follows.
GET "libhdr" LET add(x, y, m) = VALOF { LET a = x+y IF x<0 & y<0 & a>0 RESULTIS a-m IF a-m<0 RESULTIS a // Unsigned comparison RESULTIS a-m } AND mul(x, y, m) = y=0 -> 0, (y&1)=0 -> mul(add(x,x,m), y>>1, m), add(x, mul(add(x,x,m), y>>1, m), m) AND pow(x, y, m) = y=0 -> 1, (y&1)=0 -> pow(mul(x,x,m), y>>1, m), mul(x, pow(mul(x,x,m), y>>1, m), m) LET start() = VALOF { LET a, n, m = 7, 25, 19 writef("%n****%n modulo %n = %n*n", a, n, m, pow(a, n, m)) a, n, m := #x0ABCDEF0, 10000691, 1576280161 // Should give #x5AF3EBFE writef("%8x****%n modulo %n = %8x*n", a, n, m, pow(a, n, m)) RESULTIS 0 }
4.15
Compilation
So far we have looked at a few BCPL programs and invoked the BCPL compiler before running them. In this section we explore what the BCPL compiler actually does and how the compiled code is executed. To illustrate what is going on we will consider the following simple program (in bcplprogs/raspi/demo.b).
4.15. COMPILATION
GET "libhdr" LET start() = VALOF { LET n = 7 LET count = 0 { count := count+1 IF n=1 RESULTIS count TEST n MOD 2 = 0 THEN n := n/2 ELSE n := 3*n+1 } REPEAT }
65
This program declares two variables n and count initialised to 7 and zero. It then enters a REPEAT loop in which it increments count before testing to see if n is one. If it is, it returns from start with the current value of count. By convention, a non zero result is treated as an error causing its value to be output, as in:
0.010> c b demo bcpl demo.b to demo hdrs BCPLHDRS BCPL (24 July 2012) Code size = 68 bytes 0.020> demo demo failed returncode 17 reason -1 0.010>
This indicates that when it detects that n equals to 1, count equals to 17. The TEST statement causes n to be set to n/2 if n was even or 3*n+1 if n was odd. These operations are repeated until the program is terminated by the RESULTIS statement. With n initially set to 7, the sequence of values of n has length 17 and is as follows: 7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1 Before running demo we have to compile it using a command such as c b demo. The eect of this is to read the le demo.b and output a le called demo. This le can be displayed using the type command as follows:
66
0.010> type demo 000003E8 00000011 A410A317 EDBAA335 00000014 0.000>
00000011 0000DFDF 6174730B 20207472 20202020 11A4C411 84033C83 3612837B 12B5073E D1341383 00E6BAA3 00000000 00000001 00000001
At rst sight this compiled code does not look very comprehensible. It basically consists of a sequence of 32-bit words given in hexadecimal. The rst (000003E8) indicates that this is a hunk of compile code whose length is given by the next value (00000011). The rest of the le gives the actual data that must be loaded into memory before the demo program can be run. This code is much easier to understand if we use the d1 option when invoking the compiler. The output this generates is as follows:
0.000> c b demo d1 bcpl demo.b to demo hdrs BCPLHDRS d1 BCPL (24 July 2012) 0: DATAW 0x00000000 4: DATAW 0x0000DFDF 8: DATAW 0x6174730B 12: DATAW 0x20207472 16: DATAW 0x20202020 // Entry to: start 20: L1: 20: L7 21: SP3 22: L0 23: SP4 24: L3: 24: L1 25: AP4 26: SP4 27: L1 28: LP3 29: JNE L4 31: LP4 32: RTN 33: L4: 33: LP3 34: L2 35: REM
4.15. COMPILATION
36: JNE0 38: XCH 39: L2 40: DIV 41: SP3 42: J 44: L5: 44: LP3 45: L3 46: MUL 47: A1 48: SP3 49: J 51: L2: 52: DATAW 56: DATAW 60: DATAW 64: DATAW Code size = 0.030> L5
67
L3
L3 0x00000000 0x00000001 0x00000014 0x00000001 68 bytes
The word at position zero will hold the length of the compiled code when it is known, and this if followed by four words that indicate that the function named start follows at byte position 20 in this module. The compiler kindly comments this position to make the code more readable. The compiled code consists of a sequence of 8-bit bytes in a language called Cintcode (Compact Interpretice Code) that was specically designed for BCPL. Most Cintcode instructions occupy just one byte and correspond to simple operations performed on the Cintcode Abstract Machine. This machine has some central registers, the most important being PC, the program counter, that points to the next Cintcode instruction to execute, and A and B that are used during the evaluation of expressions. To see how Cintcode works we will execute this program one Cintcode instruction at a time. We can do this by typing the following piece of magic.
0.000> abort !! ABORT 99: User requested * x 0.000> demo !! BPT 9: A= * \ A= * clihook 0 B= 0 B=
0 0
20092: 48532:
K4G L7
68
The abort command enters an interactive debugger and the debugging command x sets a break point just before start is entered. When we try to execute the demo command, we immediately hits this break point just as it is about to execute the Cintcode instruction K4G 1 to enter the function start. The debugger issues the prompt * inviting us to type a debugging command. We then press the \ key to cause one Cintcode instruction to be executed leaving the system about to execute L7 at byte address 48532. We can see that both registers A and B contain zero. The compiled code for LET n = 7 is L7 to load 7 into A followed by SP3 to store A in the memory location whose address is P+3 where P is another central register of the Cintcode Machine. At this moment P points to an area of memory used to hold local variables belonging to the function start, and the compiler has chosen to allocate the location at oset 3 to hold the variable n. Pressing \ twice performs these two instructions, as follows:
* \ A= * \ A= * \ A= * 0 B= 7 B= 7 B= 0 0 0 48532: 48533: 48534: L7 SP3 L0
Initialising count can be performed by pressing \ twice more as follows:

* \ A= * \ A= * \ A= * 7 B= 0 B= 0 B= 0 7 7 48534: 48535: 48536: L0 SP4 L1
Notice that when a value is loaded into A, the previous content is copied into B. We have now entered the REPEAT loop and are about to execute the compiled code for count:=count+1 as can be seen by pressing \ three more times.
* * * * * * \ \ \ \ A= A= A= A= 0 1 1 1 B= B= B= B= 7 0 0 0 48536: 48537: 48538: 48539: L1 AP4 SP4 L1
L1 loads 1, AP4 adds the value in P4 (=count) and SP4 stores the result back in P4. The next three instruction test whether n equals 1.
4.15. COMPILATION
* * * * * \ \ \ \ A= A= A= A= 1 1 7 7 B= B= B= B= 0 1 1 1 48539: 48540: 48541: 48545: L1 LP3 JNE LP3
69
48545
L1 and LP3 load n and 1 in A and B, and the JNE 48545 instruction sets PC to 48545, if n is not equal to 1. Although the destination of the jump (48545) is too large to t into an 8-bit byte, it is actually encoded as an 8-bit signed relative address in Cintcode. So jump instructions only occupy 2 bytes. Cintcode has a cunning mechanism to deal with jumps over large distances. The next four instructions test whether n is even.
* * * * * * \ \ \ \ \ A= A= A= A= A= 7 7 2 1 1 B= B= B= B= B= 1 7 7 7 7 48545: 48546: 48547: 48548: 48556: LP3 L2 REM JNE0 LP3
48556
The REM instruction sets A to the remainder after dividing n by 2, and the JNE0 48556 instruction sets PC to 48556 if this remainder is not zero, ie if n is odd. So rather than halving n we now compute n:=3*n+1 as follows:
* * * * * * * \ \ \ \ \ \ A= A= A= A= A= A= 1 7 3 21 22 22 B= B= B= B= B= B= 7 1 7 7 7 7 48556: 48557: 48558: 48559: 48560: 48561: LP3 L3 MUL A1 SP3 J
48536
LP3 L3 MUL multiplies n by 3 giving 21, A1 increments the result giving 22, and SP3 updates n with this new value. The next instruction J 48536 jumps us back to the start of the REPEAT loop. We can remove the break point using the debugging command 0b9 and continue normal execution by typing c.
* \ A= 22 B= 7 * 0b9 * c demo failed returncode 17 reason -1 0.010> 48561: J 48536
While in the debugger, pressing ? gives a useful summary of the possible debugging commands. For more information about Cintcode and the debugger see the BCPL manual (bcplman.pdf) available via my home page.
70
4.16
The Collatz Conjecture
The previous section contained a program that computed a sequence of numbers from a given starting value using a simple rule to determine whether to replace n by n/2 or 3*n+1. Collatz conjectured in 1937 that the sequence always reaches 1 for every starting value. Surprisingly, no one has yet been able to prove this. You can learn all about the Collatz Conjecture by searching the web using the keyword Collatz. If the conjecture is false, either there will be a starting value that generates a sequence either ending in a loop not containing one, or generating larger and larger numbers indenitely. The following simple program (colllatz0.b) generates Collatz sequences from a given starting value.
GET "libhdr" LET start() = VALOF { LET n = 7 LET count = 0 { count := count+1 writef("%5i: %10i*n", count, n) IF n=1 BREAK TEST n MOD 2 = 0 THEN n := n/2 ELSE n := 3*n+1 } REPEAT RESULTIS 0 }
In this program the starting value is held in n. It outputs n and its position in the sequence before updating n with the next value. The test n MOD 2 = 0 determines whether n is even, replacing n by n/2 if it was, otherwise setting n to 3*n+1. The program breaks out of the REPEAT loop if n reaches one, otherwise it goes on for ever outputing more and more numbers in the sequence. You can easily test a dierent starting value by modifying the declaration of n. For instance, if the declaration was replaced by LET n = 123456789 you will nd the sequence terminates at position 178. An imperfection of this program is that it may suer from overow. The following program (collatz1.b corrects this fault stopping with a message when it discovers that the next value will be too large to hold in a BCPL variable. This can only happen when n is odd and 3*n+1 is greater than the largest number maxint that can be represented. So if n>(maxint-1)/3 the next number in the sequence will be too large.
4.16. THE COLLATZ CONJECTURE

GET "libhdr" LET start() = VALOF { LET n = 123456789 LET count = 0 LET lim = (maxint-1)/3 { count := count+1 writef("%5i: %10i*n", count, n) IF n=1 BREAK TEST n MOD 2 = 0 THEN { n :=n/2 } ELSE { IF n > lim DO { writef("Number too big*n") BREAK } n := 3*n+1 } } REPEAT RESULTIS 0 }
71
A variant of this program is given in Section 5.3 on page 113 that plots the relationship between sequence lengths and starting values. Even with the program given above you will not be able to nd a starting value that disproves the Collatz Conjecture since it has already been tested for all starting values up to 5 260 . So if we are going to disprove the conjecture we must modify the program to use numbers of higher precision. The following program (collatz2.b) uses numbers with up to about one million binary digits. It starts as follows:
GET "libhdr" MANIFEST { upb = (1<<20)-1 // ie about 1 million digits max mask = upb countt=10000 // count at start of test loop looplen=541 // Length of test loop } GLOBAL { digv:ug
// digv is a circular buffer holding a number with up // to upb binary digits, with one digit per element.
72
// // digq // count // digvc // digcs // countchk // digvt digts eq1 digp

Position of the least significant binary digit of the number. Position of the most significant digit of the number. Position of the number in digv in the sequence Copy of the number at last checkpoint Count of digits in digvc. Count at last checkpoint
// Digits of the number at the start of the test loop // Count of digits in digvt Returns TRUE if the number in digv is 1, ie digp=digq and digv!digp=1 Function to divide the number in digv by 2 // Function to replace the number in digv by 3*n+1 =TRUE causes the numbers to be output If TRUE, a loop of values is created to test that loops can be detected
// // divby2 // mulby3plus1 tracing // looptest // // }
The binary digits of the number are held in consecutive elements of the circular buer digv, ordered from least to most signicant digit. The least and most signicant digits have subscripts digp and digq. If the number has only one digit digp will equal digq. count holds the position of the number in digv in the sequence. In order to detect a loop the number in digv is copied into digvc every time count is a power of two. Every time the next number is generated it is compared with the number in digvc. If there is a loop this test will eventually yield TRUE. To test that the loop detection mechanism works, the variable looptest is set to TRUE. This causes the number at position countt (currently equal to 10000) to be copied into digvt, and every time count advances by looplen (currently 541) the number in digv is replaced by the number in digvt. The loop detection mechanism should detect this loop. Normally the program just output the position of each number in the sequence and its bit length, but if tracing is TRUE it also outputs the binary digits of each number. The main program is as follows:
LET start() = VALOF { LET len = 5 LET seed = 12345 LET argv = VEC 50 UNLESS rdargs("len/n,seed/n,t/s,loop/s", argv, 50) DO { writef("Bar args for collatz2*n") RESULTIS 0

} IF argv!0 DO len := !(argv!0) IF argv!1 DO seed := !(argv!1) tracing := argv!2 looptest := argv!3 setseed(seed) UNLESS 0<len<upb DO { writef("len must be in range 1 to %n*n", upb) RESULTIS 0 } digv := getvec(upb) digvc := getvec(upb) UNLESS digv & digvc DO { writef("upb too large -- more space needed*n") RESULTIS 0 } digvt := 0 IF looptest DO { digvt := getvec(upb) UNLESS digvt DO { writef("upb too large -- more space needed*n") RESULTIS 0 } } // Initialise digv with a random number of length len digp := 0 FOR i = 0 TO len-2 DO digv!i := randno(2000)/1000 digv!(len-1) := 1 // Plant a most signigicant 1 digq := len-1 // Set position of the most significant digit digcs := -1 count := 0 { LET digs = ((digq+mask+1-digp) & mask) + 1 count := count+1 writef("%9i %6i: ", count, digs) IF tracing DO prnum() newline() // // // // LEN/N SEED/N T/S LOOP/S
73
74
// Check whether the current number has been seen before IF digs = digcs DO { // Numbers are the same length so check the digits writef("Checking the digits*n", digs) FOR i = 0 TO digs-1 UNLESS digvc!i=digv!((digp+i)&mask) GOTO notsame writef("*nLoop of length %n found at count = %n*n", count-countchk, count) GOTO fin } notsame: IF (count&(count-1))=0 DO { // Set new check value in digvc FOR i = 0 TO digs-1 DO digvc!i := digv!((digp+i)&mask) digcs := digs countchk := count // Remember the position of the check value writef("%9i %6i: Set new check value*n", count, digs) } IF looptest DO { IF count=countt DO { // Create a loop starting here FOR i = 0 TO digs-1 DO digvt!i := digv!((digp+i)&mask) digts := digs writef("%9i: Save start of loop number*n", count) } IF count>countt & (count-countt) MOD looplen = 0 DO { // Return to start of test loop FOR i = 0 TO digts-1 DO digv!i := digvt!i digp, digq := 0, digts-1 writef("%9i: Restore start of loop number*n", count) } } IF eq1() BREAK TEST digv!digp=0 // Test for even THEN divby2() ELSE mulby3plus1() } REPEAT fin: IF digv DO freevec(digv) IF digvc DO freevec(digvc)

IF digvt DO freevec(digvt) RESULTIS 0 }
75
The argument len specied the length in binary digits of the initial number in the sequence. This length must be between 1 and about one million. The digits of the starting value are chosen using a random number generator whose initial seed can be specied by the seed argument. If no seed is specied as seed of 12345 is chosen. If a dened seed was not chosen, it might happen that a random starting value of say 900000 digits was found that proved the conjecture false by ending with a loop not containing one, but not knowing the seed you would not be able to reproduce your fantastic discovery. Such a situation would be unimaginably annoying. If the argument t is given tracing will be set to TRUE and if loop is given looptest will be set to TRUE to test the loop detection mechanism. The code is fairly self explanatory. It contains the loop detection mechanism and the code to generate a loop if looptest is TRUE. The call eq1() return TRUE if the current value in digv represents one. The current value in digv is even if its least signicant digit is zero, that is if digv!digp=0. The call divby2 divides the value in digv by 2, and mulby3plus1() multiplied the number in digv by three and adds one. These functions are dened below.
AND eq1() = digp=digq & digv!digp=1 -> TRUE, FALSE AND divby2() BE { TEST digp=digq THEN digv!digp := 0 ELSE digp := (digp+1)&mask } AND mulby3plus1() BE { // Calculate 3*n+1 eg // 1 + // 1011 + // 10110 = // -----// 100010 LET carry = 1 LET prev = 0 LET i = digp { LET dig = LET val = digv!i := carry := digv!i carry+dig+prev val&1 val>>1
76
prev := dig IF i=digq DO { IF prev=0=carry RETURN // No need to lengthen the number i := (i+1)&mask digv!i := 0 digq := i LOOP } i := (i+1)&mask } REPEAT } AND prnum() BE { LET i = digp { LET dig = digv!i wrch(0+dig) IF i=digq RETURN i := (i+1)&mask } REPEAT }
The nal function prnum() just outputs the digits of the number in digv. Using this program you can test random starting values with length up to about one million digits, and if there is a value that disproves the Collatz Conjecture you might be lucky enough to nd it. But I think that unlikely since I am convinced the conjecture is true.
4.17
The Queens Problem
A well known problem is to count the number of dierent ways in which eight queens can be placed on an 8 8 chess board without any two of them sharing the same row, column or diagonal. It was, for instance, used as a case study in Niklaus Wirths classic paper Program development by stepwise renement published in the Communications of the ACM in 1971. In none of his solutions did he use either recursion or bit pattern techniques. The following program solves a slight generalisation of the problem for board sizes from 1 1 to 12 12.
4.17. THE QUEENS PROBLEM

GET "libhdr" GLOBAL { count:ug all } LET try(ld, row, rd) BE TEST row=all THEN count := count + 1 ELSE { LET poss = all & WHILE poss DO { LET p = poss & poss := poss try(ld+p << 1, } } LET start() = VALOF { all := 1 FOR i = 1 TO 12 DO { count := 0 try(0, 0, 0) writef("Number of solutions to %i2-queens is %i7*n", i, count) all := 2*all + 1 } RESULTIS 0 }
77
~(ld | row | rd) -poss p row+p, rd+p >> 1)
The program performs a walk over a complete tree of valid (partial) board positions, incrementing count whenever a complete solution is found. The root of the tree is said to be at level 0 representing the empty board. The root has successors (or children) corresponding to the board states with one queen placed in the bottom row. These are all said to be at level 1. Each level 1 state has successors corresponding to valid board states with queens placed in the bottom two rows. In general, any valid board state at level i (i > 0) contain i queens in the bottom i rows and is a successor of a board state at level i 1. The solutions to the n-queens problem are the valid board states at level n when all n queens have been validly placed. Ignoring symmetries, all these solutions are be distinct. The walk over the tree of valid board states can be done without actually building the tree. It is done using the function try whose arguments ld, rows and rd contain sucient information about the current board state for its successors to be explored. Figure 4.3 illustrated how ld, rows and rd are used to nd where a queen can be validly placed in the current row without being attacked by any queen placed in earlier rows. rows is a bit pattern containing a one in for each column that is already occupied. ld contains a one for each position attacked along a left going diagonal, while rd contains diagonal attacks from the other diagonal. The expression (ld | cols | rd) is a bit pattern containing ones in
78
.

ld 0 0 0 1 1 0 0 0 rows 1 1 0 0 1 0 0 1 rd 0 0 0 1 1 1 0 0
poss Current row Q Q Q Q

.
0 0 1 0 0 0
1 0
Figure 4.3: The Eight Queens all positions that are under attack from anywhere. When this is complemented and masked with all, a bit pattern is formed that gives the positions in the current row where a queen can be placed without being attacked. The variable poss is given this as its initial value by the declaration:
LET poss = ~(ld | cols | rd) & all
The WHILE loop cunningly iterates over these possible placements, only executing the body of the loop as many times as needed. Notice that the expression poss & -poss yields the least signicant one in poss, as is shown in the following example.
poss -poss poss & -poss 00100010 11011110 -------00000010
The position of a valid queen placement is held in bit and removed from poss by:
LET bit = poss & -poss poss := poss - bit
and then a recursive call of try is made to explore the selected successor state.
try( (ld|bit)<<1, cols|bit, (rd|bit)>>1 )
4.18. SIMPLE SERIES
79
Notice that a left shift is needed for the left going diagonal attacks and a right shift for the other diagonal attacks. When rows=all a complete solution has been found and so the count of solutions is incremented. The main function start calls try to solve the n-queens problem for 1 n 12. The output is as follows:
Number Number Number Number Number Number Number Number Number Number Number Number of of of of of of of of of of of of solutions solutions solutions solutions solutions solutions solutions solutions solutions solutions solutions solutions to 1-queens is to 2-queens is to 3-queens is to 4-queens is to 5-queens is to 6-queens is to 7-queens is to 8-queens is to 9-queens is to 10-queens is to 11-queens is to 12-queens is 1 0 0 2 10 4 40 92 352 724 2680 14200
4.18
Simple series
We have seen that the largest number we can represent in an unsigned 32-bit word is 1 + 2 + 22 + 23 + . . . + 231 This is perfectly understandable and is called a series, but mathematicians do not normally like to use dots since they introduce possible misunderstandings of what is being omitted. They generally prefer the following notation.
31
2i
i=0
but in this document I will almost always use the dot notation. We can generalise this series to term n, replacing the constant 2 by some arbitrary value x and call the sum s, namely s = 1 + x + x2 + x3 + . . . + xn We can easily make a simple formula for s by considering s multiplied by (x 1), that is
80 s(x 1)
CHAPTER 4. THE BCPL CINTCODE SYSTEM = (1 + x + x2 + x3 + . . . + xn ) x (1 + x + x2 + x3 + . . . + xn ) = (x + x2 + x3 + . . . + xn+1 ) (1 + x + x2 + x3 + . . . + xn ) = xn+1 1
So xn+1 1 x1
s=
So for our original series, x = 2 and n = 31 gives us 232 1 = 232 1 = 4294967295 21
s=
Notice that with x = 2 as n gets larger so does the sum. When x = 2, the series is said to diverge as n tends to innity (an incredibly large number often represented by ). But what happens if x < 1. Let us try x = 1 and n = . 2
1 (2 ) 1 01 = 1 =2 1 1 1 2 2
s=
) to be zero since multiplying 1 by 1 a huge In the above derivation, we took ( 1 2 2 number of times gets so small its value can be ignored. As a demonstration of the use of vectors and functions we will look a a program called eval2.b that calculates s to 2000 decimal places to show that it is indeed 2. It starts as follows.
GET "libhdr" GLOBAL { sum:ug term upb } LET start() = VALOF { upb := 2004/4 // Each element holds 4 decimal digits // and there are 4 guard digits at the end. sum := getvec(upb) term := getvec(upb)
4.18. SIMPLE SERIES

settok(sum, 0) sum!upb := 5000 settok(term, 1)
81
// Add 1/2 at digit position 2000 for rounding
UNTIL iszero(term) DO { add(sum, term) divbyk(term, 2) } // Write out the sum to 40 decimal places writef("*nsum = %n.", sum!0) FOR i = 1 TO 10 DO writef("%4z ", sum!i) newline() fin: freevec(sum) freevec(term) RESULTIS 0 }
It uses the vector sum to hold the summation of all the terms and term to hold the next term to add to sum. Both sum and term are vectors with upperbound 2004/4 which is sucient to hold numbers with 4 decimal digits before the decimal point and 2000 digits after the decimal point together with a further 4 guard digits at the end. sum and term are initialised by calls of settok, described later, and 5000 is placed in the last element of sum which corresponds to adding 1/2 at decimal digit position 2000. This causes appropriate rounding to take place. The UNTIL loop adds term to sum dividing term by 2 each time until term represents zero. sum is then output to 40 decimal places as follows:
sum = 2.0000 0000 0000 0000 0000 0000 0000 0000 0000 0000
as expected. The rest of the program denes the functions settok, add, divbyk and iszero as follows.
AND settok(v, k) BE { v!0 := k FOR i = 1 TO upb DO v!i := 0 } AND add(a, b) BE { LET c = 0
82
FOR i { LET a!i c } } AND divbyk(v, k) BE { LET c = 0 FOR i = 0 TO upb DO { LET d = c*10000 + v!i v!i := d / k c := d MOD k } }

= upb TO 0 BY -1 DO d = c + a!i + b!i := d MOD 10000 := d / 10000
AND iszero(v) = VALOF { FOR i = upb TO 0 BY -1 IF v!i RESULTIS FALSE RESULTIS TRUE }
The function settok is self explanatory. Notice that add performs the addition from the least signicant end using the variable c to hold the carry. divbyk performs short division from the most signicant end, again using c to hold the carry. Finally, iszero only returns TRUE if every element of v is zero.
4.19
e to 2000 decimal places
The constant e which has a value of approximately 2.71828 is one of the most important constants in mathematics. It can be dened in many ways, but the one we will use in this section is: e=1+1+ 1 + 2
1 3!
+ ... +
1 n!
+ ...
where n! stands for n factorial (1 1 2 3 . . . n). This section presents a simple program (evale.b) that computes e to 2000 decimal places. As with the previous program, it is primarily an example of the use of vectors and functions, and, as with the previous program, it uses high precision numbers using vectors whose elements each contain 4 decimal digits. It is convenient to think of these elements as digits of radix 10000. A radix of 10000 was chosen because 100002 easily ts in a 32-bit word, but 1000002 does not. The program starts as follows.
4.19. E TO 2000 DECIMAL PLACES

GET "libhdr" GLOBAL { sum:ug term tab digcount digits upb }
83
// The sum of terms so far // The next term to add to sum // The frequency counts of the digits of e // The number of decimal digits to calculate
LET start() = VALOF { LET n = 1 digits := 2000 upb := (digits+10)/4 tab := getvec(9) sum := getvec(upb) term := getvec(upb)
// // // // //
Calculate e to 2000 decimal places add ten guard digits for digit frequency counts will hold the sum of the series the next term in the series to add to sum
UNLESS tab & sum & term DO { writef("Unable to allocate vectors*n") GOTO fin } settok(sum, 1) settok(term, 1) UNTIL iszero(term) DO { add(sum, term) n := n + 1 divbyk(term, n) } // Write out e writes("*ne = *n") print(sum) // Write out the digit frequency counts writes("*nDigit counts*n") FOR i = 0 TO 9 DO writef("%n:%i3 ", i, tab!i) newline() fin: freevec(tab) freevec(sum) // Initial value of sum // The first term to add // Until the term is zero // Add the term to sum // Calculate the next term
84
freevec(term) RESULTIS 0 }
The program ends with the denitions of the functions used, most of which we have already seen.
AND settok(v, k) BE { v!0 := k // Set the integer part FOR i = 1 TO upb DO v!i := 0 // Clear all fractional digits } AND add(a, b) BE { LET c = 0 FOR i = upb TO 0 BY -1 DO { LET d = c + a!i + b!i a!i := d MOD 10000 c := d / 10000 } } AND divbyk(v, k) BE { LET c = 0 FOR i = 0 TO upb DO { LET d = c*10000 + v!i v!i := d / k c := d MOD k } } AND iszero(v) = VALOF { FOR i = upb TO 0 BY -1 IF v!i RESULTIS FALSE RESULTIS TRUE }
The nal two functions output the high precision number held in v as a sequence of decimal digits.
AND print(v) BE { FOR i = 0 TO 9 DO tab!i := 0 // Clear the frequency counts digcount := 0 writef(" %i4.", v!0) FOR i = 1 TO upb DO { IF i MOD 15 = 0 DO writes("*n ")
4.19. E TO 2000 DECIMAL PLACES

wrpn(v!i, 4) wrch(*s) } newline() } AND wrpn(n, d) BE { IF d>1 DO wrpn(n/10, d-1) IF digcount>=digits RETURN n := n MOD 10 tab!n := tab!n + 1 wrch(n+0) digcount := digcount+1 }
85
When the program is run its output is as follows. e = 2.7182 6967 6277 9921 8174 3233 8298 9244 7614 2069 5517 ... 4995 6398 4310 8889 1172 8418 8862 7727 0595 0313 7211 8294 8182 2407 1359 8075 6066 0276 8459 6630 6629 3195 8082 1838 0452 3535 0435 2510 2648 6062 3536 4759 7290 1901 0016 6133 0287 4571 0334 1573 8477 1384 4713 3821 2952 8341 4118 5830 5266 7852 6059 8793 5374 0075 2497 5166 5630 0702 2345 2044 7572 4274 7381 1540 4424 9338 4709 2746 3232 8914 3710 2656 3699 6391 8627 9934 7539 0297 9595 9320 9434 8841 0777 6067 7496 0305 9076 6750 4499 3711
3428 5471 8411 6020 5551 7876
1899 0962 6612 5724 9486 1085
7077 9537 0545 8176 6850 2639
3327 4152 2970 5851 8003 8139
6171 1115 3023 1806 6853
7839 1368 6472 3036 2281
2803 3506 5492 4428 8315
4946 2752 9666 1231 2196
5014 6023 9381 4965 0037
3455 2648 1513 5070 3562
8897 4728 7322 4751 5279
0719 7039 7536 0254 4495
4258 2076 4509 4650 1582
Digit counts 0:196 1:190
2:207
3:202
4:201
5:197
6:204
7:198
8:202
9:203
The frequency counts have been output because they have the remarkable property of being very much closer to 200 that we should expect. There is a simple statistical test (the 2 test), covered in the next section, that shows just how unlikely these counts are assuming each digit is equally likely to be any digit in the range 0 to 9 and is independent of the other digits in the series.
86
4.20
The 2 test
Feel free to skip this section if the formula below looks too frightening. The program above showed us that, for e, the counts of each digit in the 2000 digits after the decimal point are 196, 190, 207, 202, 201, 197, 204, 198, 202 and 203. Since there are 2000 digits in all we would expect each to occur about 200 times, but, of course, we would also expect some random deviation from this average. Statisticians have devised a test (the 2 test) that allows us to see if our collection of counts is reasonable. The method is as follows. First we calculate the quantity 2 dened as follow.
2 =
(xi i )2 i i=1
where k is the number of counts, xi is the ith count and i is the expected value for xi which in our case is always 200. Putting our counts into the formula we obtain 2 =
200)2 200)2 (196200)2 + (190200 + (207200 200 (197200)2 200)2 200)2 + (204200 + (198200 200 16+100+49+4+1+9+16+4+4+9 200 212 200
+ +
(202200)2 200 (202200)2 200
+ +
(201200)2 + 200 (203200)2 200
= = = 1.06
We had 10 counts but since they add up to 2000 the last count depends on the rst 9, so for our collection the so called number of degrees of freedom is 9. We can lookup our value of 2 in the the table for 9 degrees of freedom to nd the probability that 2 would be greater than 1.06, assuming the digits are random and independent of one another. If you search the web using terms chi squared distribution calculator, you will nd several web pages that will calculate the probability that 2 should be greater than 1.06 for 9 degrees of freedom. The answer turns out to be 0.9993, so the chance that 2 is 1.06 or smaller is less than one in a thousand.
4.21
ex
The previous section dened e as the sum of a beautiful series whose nth was 1 . Just for fun let us see what happens when we multiply this series by itself. n! Clearly the result should be a series representing e2 . So we have to simplify
4.21. E X (1 +
1 1!
87 +
1 2!
1 3!
+ . . .) (1 +
1 1!
1 2!
1 3!
+ . . .)
We can multiply each element of the left hand term by each element of the right hand term in a systematic way as follows 11
1 1! 1 2! 1 3!
=
1 1! 1 1! 1 1!
1
1+1 1! 1+2+1 2! 1+3+3+1 3!
= = = =
1
2 1! 22 2! 23 3!
1+1 1+ 1+
1 1! 1 2!
= +1 +
1 1! 1 2! 1 2!
= +1
1 3!
This shows that e2 = 1 +

2 1!
22 2!
23 3!
+ ...
Seeing this equation leads us to thinking that ex = 1 +

x 1!
x2 2!
x3 3!
+ ...
might be true. After all, it is certainly true when x is 0, 1 or 2. We can increase our believe that it is true by considering the product of the series for ex and ey to see if it yields the series for ex+y . We can do this by multiplying each element of the left hand term by each element of the right hand term in a systematic way as follows 11
x 1! x2 2! x3 3!
=
1 1! y 1! y 1!
1
x+y 1! x2 +2xy +y 2 2! x3 +3x2 y +3xy 2 +y 3 3!
= = = =
1
(x+y ) 1! (x+y )2 2! (x+y )3 3!
1+y 1+ 1+
x 1! x2 2!
= +1 +
x 1! y 2! y2 2!
= +1
y3 3!
This shows that ex ey = 1 +

(x+y ) 1!
(x+y )2 2!
(x+y )3 3!
+ ...
which correctly represents the series for ex+y , as expected. So far we have assumed that x and y are integers, but the algebra we have just used works just as well when x and y are not whole numbers. Consider, for 1 example, e 2 . This clearly represents e since
88
CHAPTER 4. THE BCPL CINTCODE SYSTEM e2 e2 = e2+2 = e

1 1 1 1
Similarly, e q is the q th root of e. We can safely assume that our series works for where p and q are whole numbers. This leads us to believe the any x of the form p q formula is correct even when x cannot be represented as the ratio of two whole numbers. Examples of such numbers are 2, and even e itself.
4.22
The extraordinary number e
163
This number is peculiar since it has 18 digits to the left of the decimal point, but a sequence of 12 nines to the right of the decimal point. The following program demonstrates this by computing its value to sucient precision. The program is called epr163.b and starts as follows. GET "libhdr" MANIFEST { upb = 12 upb1 = upb+1 } LET start() = VALOF { LET pi = VEC AND root163 = VEC AND x = VEC AND ex = VEC LET exponent = 0
upb upb upb upb
numfromstr(pi, upb, "3.14159265358979323846264338327950* *288419716939937510582097494459230") writef("*nPi is*n") print(pi, 0) // Calculate root 163 sqrt163(root163) writef("*nRoot 163 is*n") print(root163, 0) mult(x, pi, root163) writef("*nPi times Root 163 is*n") print(x, 0)
4.22. THE EXTRAORDINARY NUMBER E
163
89
// Divide x by 2**10 (=1024) to make the computation // e to the power x converge much more rapidly. divbyk(x, 1024) exp(ex, x) // Now square the result 10 times. FOR i = 1 TO 10 DO { exponent := 2*exponent mult(ex, ex, ex) IF ex!0>10000 DO { divbyk(ex, 10000) exponent := exponent + 1 } } // Output the result writef("*ne to the Pi root 163 is*n") print(ex, exponent) RESULTIS 0 } A high precision number is represented by vector whose elements each contain four decimal digits. It is best to think of them as digits of radix 10000. The zeroth element is the integer part and the other elements contain the fractional digits. The upper bound of the vector is upb, set to 12, to allow a precision of over 40 decimal digits which is sucient for Four such vectors pi, root163, our purposes. 163 x, ex are declared to represent , 163, 163 and e , respectively. The function numfromstr is used to initialise pi from a string holding the digits of . The call sqrt163(root163) places a representation of 163 in root163. The product of pi and root163 is placed in x using mult. Since x is about 40, the convergence of the series for ex would be very slow, so x is reduced in size by dividing it by 1024 (= 210 ) before summing the series for ex , placing the result in ex by the call exp(ex, x). The result in ex is then squared 10 times to give a 163 representation of e . The only problem is that this value is outside the range of values our high precision numbers can hold. This is solved by maintaining an exponent value in exponent which specied that the number in ex should be multiplied by 10000exponent . Each time ex is squared, exponent is doubled, and if ex has become too large it is divided by 10000 and exponent incremented by one. The additional functions used by this program are as follows. AND numfromstr(v, upb, s) BE { LET p, k, val = 0, 0, k FOR i = 1 TO s%0 DO
90
CHAPTER 4. THE BCPL CINTCODE SYSTEM { LET ch = s%i IF 0<=ch<=9 DO val, k := 10*val + ch - 0, k+1 IF ch=. | k=4 DO { IF p<=upb DO v!p := val p, k, val := p+1, 0, 0 } } UNTIL k=4 DO val, k := 10*val, k+1 IF p<=upb DO v!p := val // Pad on the right with zeroes UNTIL p>=upb DO { p := p+1; v!p := 0 }
} This take a character string in s and converts it into our high precision representation using the vector v whose upper bound is upb. AND sqrt163(x) BE { // This is a simple but inefficient function to // calculate the square root of 163. LET w = VEC upb AND eps = VEC upb AND n163 = VEC upb numfromstr(x, upb, "13.") // Initial guess numfromstr(n163, upb, "163.") { mult(w, x, x) TEST w!0>=163 THEN { sub(eps, w, n163) divbyk(eps, 24) sub(x, x, eps) } ELSE { sub(eps, n163, w) divbyk(eps, 24) add(x, x, eps) } //print(x, 0) } REPEATUNTIL iszero(eps) } As the comment says this is a simple function to set x to a high precision representaion of 163. There was no need to use the much faster Newton-Raphson method.
163
91
AND mult(x, y, z) BE { LET res = VEC upb1 numfromstr(res, upb1, "0.") // Round by adding a half to the last digit position. res!upb1 := 5000 FOR i = 0 TO upb IF y!i FOR j = 0 TO upb1-i DO { LET p = i + j // p is in range 0 to upb1 LET carry = y!i * z!j WHILE carry DO { LET w = res!p + carry IF p=0 DO { res!0 := w; BREAK } res!p, carry := w MOD 10000, w/10000 p := p-1 } } FOR i = 0 TO upb DO x!i := res!i } This function multiplies the high precision numbers in y and z placing the rounded result in x. It uses a temporary vector res that includes an extra digit to allow for rounding. Every pair of digits that can contribute to the result are multiplied together and added to the appropriate position in res, dealing with carries as they arise. AND exp(ex, x) BE { // This calculates e to the power x by summing the series // whose nth term is x**n/n! LET n = 0 LET term = VEC upb numfromstr(term, upb, "1.") numfromstr(ex, upb, "0.") UNTIL iszero(term) DO { add(ex, ex, term) n := n+1 mult(term, term, x) divbyk(term, n) } } This computes ex using the series ex = 1 + x + x2 x3 x4 + + + ... 2! 3! 4!
92
The result is accumulated in ex and term holds the next term to be added. The summation stops when term holds zero. AND add(x, y, z) BE { LET c = 0 FOR i = upb TO 0 BY -1 DO { LET d = c + y!i + z!i x!i := d MOD 10000 c := d / 10000 } } This function adds the high precision numbers in y and z placing the result in x. AND sub(x, y, z) BE { LET borrow = 0 FOR i = upb TO 1 BY -1 DO { LET d = y!i - borrow - z!i borrow := 0 UNTIL d>=0 DO borrow, d := borrow+1, d+10000 x!i := d } x!0 := y!0 - borrow - z!0 } This function subtracts the high precision number in z from y placing the result in x. AND divbyk(v, k) BE { LET c = 0 FOR i = 0 TO upb DO { LET d = c*10000 + v!i v!i := d / k c := d MOD k } } This divides the high precision number in v by k which must be in the range 1 to 10000.
163
93
AND iszero(v) = VALOF { FOR i = upb TO 0 BY -1 IF v!i RESULTIS FALSE RESULTIS TRUE } This returns TRUE is the high precision number in v is zero. AND print(v, exponent) BE { writef("%i4", v!0) FOR i = 1 TO upb DO { wrch(exponent=0 -> ., *s) exponent := exponent - 1 IF i MOD 15 = 0 DO newline() wrpn(v!i, 4) } newline() } AND wrpn(n, d) BE { IF d>1 DO wrpn(n/10, d-1) wrch(n MOD 10 +0) } These two functions combine to output a high precision number with a given exponent. When this program runs, its output is as follows. Pi is 3.1415 9265 3589 7932 3846 2643 3832 7950 2884 1971 6939 9375 Root 163 is 12.7671 4533 4803 7046 6171 0952 0097 8089 2347 3823 6377 9407 Pi times Root 163 is 40.1091 6999 1132 5197 5535 0083 6229 0414 0053 9005 3481 5142 e to the Pi root 163 is 26 2537 4126 4076 8743.9999 9999 9999 2500 7259 7198 1820 2936
94
4.23
Digits of
This section is another illustration of the use of modulo arithmetic. It is entirely optional and can be skipped. The ratio of the circumference of a circle to its diameter is a very important constant called , and it has a value of about 3.14159, and some people like or 355 . In the mid 1930s, was known to about to use the approximations 22 7 113 700 decimal places but now, with the aid of computers and staggeringly cunning methods it can be calculated to billions (and even trillions) of decimal places. For more information do a web search on: digits of pi. One intriguing method was discovered by David Bailey, Peter Borwein and Simon Ploe and appears in section 10.7 of Number Theory, A Programmers Guide by Mark Herkommer. It is based on the totally remarkable formula:
=
i=0
2 1 1 1 4 ) ( )i 8i + 1 8i + 4 8i + 5 8i + 6 16
The beauty of this formula is that it can be used to calculate the nth hexadecimal digit of pi using modulo arithmetic with the big advantage that the other digits are not computed. So how do we do it? We multiply the right hand side by 16n and split it into the rst n terms and the rest, namely
n1
(
i=0
16ni 16ni 4 16ni 2 16ni ) 8i + 1 8i + 4 8i + 5 8i + 6
and
(
i=n
4 2 1 1 1 ) ( )in 8i + 1 8i + 4 8i + 5 8i + 6 16
If we add these two sums together, we obtain a huge number, and if we represent it using hexadecimal digits we nd that the rst digit to the right of the decimal point is the nth hex digit of . If we are only interested in this digit all the digits to the left of the decimal point can be discarded and only a few to the right of the decimal point need to be retained during the calculation. Let us consider the rst term in the rst sum. The contribution this term makes to the result is
n1
4(
i=0
16ni ) 8i + 1
But we are only interested in the fractional part, so the following sum will do just as well.
4.23. DIGITS OF
95
n1
4(
i=0
16ni mod(8i + 1) ) 8i + 1
Computing 16ni mod(8i + 1) throws away all integer multiples of (8i + 1) leaving only the remainder, which is positive but less than 8i + 1, so when this is divided by 8i + 1 yields a value between 0 and 1. This trick is similar to calculating the fractional part of 123/10 as follow: 123mod10 3 123 = = = 0.3 10 10 10 A program to output the digits of bcplprogs/raspi/pidigs.b. It starts as follows:
GET "libhdr" MANIFEST { // Define the scaled arithmetic parameters fraclen = 28 // Number of binary digits after the decimal point // 28 allows numbers in the range -8.0 <= x < 8.0 // eg #x10000000 Two = 2*One // eg #x20000000 Four = 4*One // eg #x40000000 fracmask = One - 1 // eg #x0FFFFFFF } LET start() = VALOF { writef("*n 3.") FOR n = 0 TO 1000 DO { IF n MOD 50 = 0 DO writef("*n%5i: ", n) writef("%x1", pihexdig(n)); deplete(cos) } newline() RESULTIS 0 }
in
hexadecimal
is
in
The constant fraclen (=28) species the number of binary digits after the decimal point of the scaled numbers we will be using. This leaves 4 bits (or one hexdecimal digit) to the left of the decimal point. We will be using signed arithmetic, so this allows us to represent numbers greater than or equal to -8.000 and less than 8.000 which is sucient for our purposes. The constants One, Two
96
and Four represent the the numbers 1, 2 and 4 in this scaled representation, and fracmask is a bit pattern that will extract just the fractional bits of our numbers. The main function start just outputs the hexadecimal digits of up to position 1000, placing 50 digits per line. Each digit is calculated by calls of pihexdig. The library function muldiv take three signed numbers and returns the mathematically correct result of dividing the third argument into the product of the rst two. Thus muldiv(x,y,z)=(x*y)/z, but x*y is computed as a double length quantity. The function powmod(x,n,m), dened later, computes xn mod(m) with reasonably eciently. Note that muldiv(Four, powmod(16, n-i, 8*i+1), 8*i+1) will return the value of 4( 16ni mod(8i + 1) ) 8i + 1
as a number using our scaled representation. The denition of pihexdig is as follows.

AND pihexdig(n) = VALOF { LET s = 0 // A scaled number with fraclen binary digits // after the decimal point. LET t = One FOR i { LET LET LET LET = a b c d 0 = = = = TO n-1 DO muldiv(Four, muldiv( Two, muldiv( One, muldiv( One,
powmod(16, powmod(16, powmod(16, powmod(16,
n-i, n-i, n-i, n-i,
8*i+1), 8*i+4), 8*i+5), 8*i+6),
8*i+1) 8*i+4) 8*i+5) 8*i+6)
s := s + a - b - c - d & fracmask } // Now add the remaining terms until they are too small // to matter. { LET i = n WHILE t DO { LET a = 4 * t / (8*i+1) LET b = 2 * t / (8*i+4) LET c = t / (8*i+5) LET d = t / (8*i+6)
4.23. DIGITS OF
s := s + a - b - c - d & fracmask i, t := i+1, t/16 } } RESULTIS (s>>(fraclen-4)) & #xF // Extract the required digit }
97
To complete the program, the denition of powmod is as on Page 63, namely

AND powmod(x, n, m) = VALOF { LET res = 1 LET p = x MOD m WHILE n DO { UNLESS (n & 1)=0 DO res := (res * p) MOD m n := n>>1 p := (p*p) MOD m // DANGER: p*p must not overflow } RESULTIS res }
The actual program in raspi/pidigs.b contains some optional tracing code as a debugging aid. The values of a, b, c, d, and s can be output in decimal and hexadecimal as they are computed using the function tr, as in tr("a", a). The denition of tr is as follows.
AND tr(str, x) BE { // Output scaled number x in decimal and hex LET d = muldiv( 1_000_000, x, One) LET h = muldiv(#x10000000, x, One) // Just in case fraclen is not 28 writef("%s = %9.6d %8x*n", str, d, h) }
When pidigs runs it generates the following output.

0.000> pidigs 3. 243F6A8885A308D313198A2E03707344A4093822299F31D008 2EFA98EC4E6C89452821E638D01377BE5466CF34E90C6CC0AC 29B7C97C50DD3F84D5B5B54709179216D5D98979FB1BD1310B A698DFB5AC2FFD72DBD01ADFB7B8E1AFED6A267E96BA7C9045 F12C7F9924A19947B3916CF70801F2E2858EFC16636920D871 574E69A458FEA3F4933D7E0D95748F728EB658718BCD588215 4AEE7B54A41DC25A59B59C30D5392AF26013C5D1B023286085
0: 50: 100: 150: 200: 250: 300:
98
350: 400: 450: 500: 550: 600: 650: 700: 750: 800: 850: 900: 950: 1000: 2.730>

F0CA417918B8DB38EF8E79DCB0603A180E6C9E0E8BB01E8A3E D71577C1BD314B2778AF2FDA55605C60E65525F3AA55AB9457 48986263E8144055CA396A2AAB10B6B4CC5C341141E8CEA154 86AF7C72E993B3EE1411636FBC2A2BA9C55D741831F6CE5C3E 169B87931EAFD6BA336C24CF5C7A325381289586773B8F4898 6B4BB9AFC4BFE81B6628219361D809CCFB21A991487CAC605D EC8032EF845D5DE98575B1DC262302EB651B8823893E81D396 ACC50F6D6FF383F442392E0B4482A484200469C8F04A9E1F9B 5E21C66842F6E96C9A670C9C61ABD388F06A51A0D2D8542F68 960FA728AB5133A36EEF0B6C137A3BE4BA3BF0507EFB2A98A1 F1651D39AF017666CA593E82430E888CEE8619456F9FB47D84 A5C33B8B5EBEE06F75D885C12073401A449F56C16AA64ED3AA 62363F77061BFEDF72429B023D37D0D724D00A1248DB0FEAD3 4
By changing to bounds of the FOR loop in start, you can discover that the hexadecimal digit at position one million is 6, which I think is remarkable for such a small program. But beware, 28 fractional bits does not have sucient precision to guarantee all digits from position zero to one million are correct. Try reducing fraclen to see where errors begin to creep in. For instance, if fraclen=22 the rst error is at position 1269, and 25 gives an error at 3708. 28 gives correct digits at least up to position 5000. Unfortunately, if you want more than 28 bits the program will need substantial modication.
4.24
More commands
To be written
4.25
The VSPL Compiler
As a nal example we will look at a somewhat more substantial program. BCPL was originally written to help with the implementation of programming language compilers, and its own compiler is a good example. It is, however, too long and complicated to be used as an introduction to compiler writing. A much simpler language called VSPL (Very Simple Programming Language) was designed as an educational tool showing how a compiler can be written in several languages using dierent programming styles. If you are interested, look at the VSPL distribution available from my home page. The standard BCPL distribution includes the BCPL version of the VSPL compiler in com/vspl.b together with two example programs primes.vs and demo.vs in the BCPL root directory. When printed vspl.b is only 21 pages long, but does contain a lexical
4.26. SUMMARY OF BCPL
99
analyser, a parser, a translation phase and an interpreter to execute the compiled code. It also contains debugging aids to help you understand how the compiler works. To explore the VSPL system, try typing the following commands. cd $BCPLROOT cintsys c bc vspl type primes.vs vspl primes.vs type demo.vs vspl -l demo.vs vspl -p demo.vs vspl -c demo.vs vspl -t demo.vs ----------Enter the BCPLROOT directory Start the BCPL system Compile the VSPL compiler Look at a typical VSPL program Compile and run it Look at a tiny demo program Look at the result of lexical analysis Look at the parse tree Look at the compiled code Trace the execution of the compiled code
For more information look at the VSPL distribution available via my home page.
4.26
Summary of BCPL
This section is still under development This section gives a summary of BCPL. For a full description of the language look at the BCPL Manual given in my home page. In the syntactic forms given below E K C D A N denotes denotes denotes denotes denotes denotes an expression, a constant expression, a command, a denition, an function argument list, a variable name,
4.26.1
Comments and GET
Text between // and the end of the line is ignored. The symbols /* and */ are called comment brackets. These brackets and the text enclosed between them are ignored. Such comments may be nested. A GET directive of the form GET "filename" as in GET "libhdr" is replaced by the contents of the specied le. GET rst searches the current directory and then the directories specied by the BCPLHDRS environment variable. If the le name does not end with .h or .b, .h is appended.
100
4.26.2
Sections
A section is a sequence of declarations optionally preceeded by a SECTION directive of the form SECTION "name". Several sections can occur in one le separated by dots.
4.26.3
Declarations
LET D AND ... AND D AND joins simultaneous denitions together. All the variables dened have a scope starting at the word LET. MANIFEST { N = K ;...; N = K } The = K s are optional. When omitted the next available integer is used. STATIC { N = K ;...; N = K } The = K s are optional. When omitted the the corresponding variables have undened initial values. GLOBAL { N : K ;...; N : K } The : K s are optional. When omitted the next available integer is used.
4.26.4
Denitions
Denitions are used in declarations after the word LET or AND. They are as follows. N ,..., N = E ,..., E This is a simultaneous denition dening a list of local variables with specied initial values. They are allocated consective locations in memory. N = VEC K This is a local vector denition. It denes a local variable N with an initial value that points to the zeroth element of a local vector whose upper bound is the constant K. N ( N ,..., N ) = E This denes a function that returns a result specied by the expression E. It has zero or more arguments. N ( N ,..., N ) BE C This denes a function just like the one above but has no specied result.
4.26.5
N
Expressions
Eg: abc v1 a s err These are used to name functions, variables and constants.
4.26. SUMMARY OF BCPL numb Eg: 1234 #x7F 0001 #377 #b 0111 1111 0000 These yield specied constant values. ? This yields an undened value. TRUE FALSE These represent the two truth values -1 and 0, respectively. char Eg: A *n These character constants are encoded as numbers in the range 0 to 255.
101
string Eg: "abc" "Hello*n" A string is represented by a pointer to where the characters of the string are packed. The individual characters are encoded as 8-bit bytes and can be accessed using the percent operator %. The zeroth character of a string holds its upper bound. TABLE K ,..., K This yields an initialised static vector. The elements of the vector are initialised to the given compile time constants. VALOF C This introduces a new scope for locals and denes the context for RESULTIS commands within C . ( E ) Parentheses are used to override the normal precedence of the expression operators. E ( E ,..., E ) This is a function call. @ E This returns the address of E which must be either a variable name or of the form E!E or !E. E ! E ! E This is the subscription operator. The left operand is a pointer to the zeroth element of a vector and the right hand operand is an integer subscript. The form !E is equivalent to E!0. E % E This is the byte subscription operator. The left operand is a pointer to the zeroth element of a byte vector and the right hand operand is an integer subscript. + E - E ABS E These are monadic operators for plus, minus and absolute value, respectively. E * E E / E E MOD E These are dyadic operators for multiplication, division, remainder after division, respectively.
102
E + E E - E These are dyadic operators for addition and subtraction, respectively. E relop E relop ... relop E where relop is any of =, =, <, <=, > or >=. It return TRUE only if all the individual relations are satised. E << E E >> E These are logical left and right shift operators, respectively. E This returns the bitwise complement of E. E & E This returns the bitwise AND of its operands. E | E This returns the bitwise OR of its operands. E XOR E This returns the bitwise exclusive OR of its operands. E -> E, E This is the conditional expression construct.
4.26.6
Commands
E ,..., E := E ,..., E This is the simultaneous assignment operator. The order in which the expressions are evaluated is undened. TEST E THEN C ELSE C IF E DO C UNLESS E DO C These are the conditional commands. They are less binding than assignment. SWITCHON E INTO C DEFAULT: CASE K: ENDCASE The DEFAULT label and CASE labels identify positions within the body of a SWITCHON command. The eect of a SWITCHON command is to evaluate E and then transfer control to the matching CASE label. If no CASE label matches control is passed to the DEFAULT label, but if there is no DEFAULT label control exits from the SWITCHON command. ENDCASE causes an exit from the SWITCHON command. It normally occurs at the end of the code for each case. WHILE E DO C UNTIL E DO C
4.26. SUMMARY OF BCPL
103
C REPEATWHILE E C REPEATUNTIL E C REPEAT FOR N = E TO E BY K DO C FOR N = E TO E DO C These are the repetitive commands. The FOR command introduces a new scope for locals, and N is a new variable within this scope. RESULTIS E This returns from current VALOF expression with the given value. RETURN Return from current function with an undened value. BREAK LOOP Respectively, exit from, or loop in the current repetitive command. N: GOTO E: The construct N: sets a label to this point in the program, and the GOTO command can be used to transfer to this point. However, the GOTO and the label must be in the same function. C ;...; C Evaluate the commands from left to right. {C ;...; C} This construct is called a compound command and is treated syntactically as a single command. It can, for instance, be the operand of an IF statement. A sequence of declaration is permitted immediately after the open section bracket ({). This causes it to be called a block. The declared names have a scope limited to the block.
4.26.7
Constant expressions
These are used in MANIFEST, STATIC and GLOBAL declarations, in VEC denitions, and in the step length of FOR commands. The syntax of constant expressions is the same as that of ordinary expressions except that only constructs that can be evaluated at compile time are permitted. These are: N, numb, ?, TRUE, FALSE, char, ( K ), k, + K, - K, ABS K, K * K, K / K, K MOD K K + K, K - K, K relop K relop ... relop K,
104 K << K, K >> K, K, K & K, K | K, K XOR K, K -> K, K
Chapter 5 Interactive Graphics in BCPL using SDL

5.1 Introduction
If your system does not already have the SDL libraries and header les installed, you should fetch them using commands such as the following. sudo apt-get install libsdl1.2-dev libsdl-image1.2-dev sudo apt-get install libsdl-mixer1.2-dev libsdl-ttf2.0-dev sudo apt-get update When I tried the above commands on a newly installed Linux image, some worrying error messages were generated by the rst two apt-get install commands. But running them again after the apt-get update had been performed seem to make them install SDL correctly. As a test to see if they have been installed examine the directory /usr/include/SDL. It should contain several les relating to SDL. Having installed the SDL libraries you should rebuild the BCPL system telling it to use the libraries. To do this type the following. cd ~/distribution/BCPL/cintcode make clean make -f MakefileRaspiSDL This should rebuild the BCPL system from its source incorporating and interface with SDL. Although all the programs in this chapter can be controlled from the keyboard, you may nd it useful to plug a USB joystick into your Raspberry Pi. I bought a 105
106
CHAPTER 5. INTERACTIVE GRAPHICS IN BCPL USING SDL
Logitech Attack 3 Joystick which is cheap, well made and works well. It is shown below. Although it provides elevator, aileron and throttle control together with 11 buttons, it does not provide a convenient rudder control, so you might wish to buy a more expensive model.
To test whether you have installed the SDL graphics library correctly, try compiling and running the demonstration program bcplprogs/raspi/sdldemo1.b by typing the following commands. cd ~/distribution/BCPL/bcplprogs/raspi cintsys c b engine engine This should create and display the following window for about 20 seconds.
5.1. INTRODUCTION
107
The program starts as follow.

GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
// Insert the library source code
The rst four lines consisting of three GET directives and a dot, cause a BCPL interface to the SDL library to be compiled as a separate section at the head of the program. The source is in cintcode/g/sdl.b and it uses a header le called cintcode/g/sdl.h. In due course you should look at these les to see what is provided, but that can wait. The program goes on to declare some global vaiables that will be used to hold the various colours.
GLOBAL { col_black:ug col_blue col_green col_yellow col_red col_majenta col_cyan col_white col_darkgray
108
col_darkblue col_darkgreen col_darkyellow col_darkred col_darkmajenta col_darkcyan col_gray col_lightgray col_lightblue col_lightgreen col_lightyellow col_lightred col_lightmajenta col_lightcyan }
The rest of the program just contains the denition of the main program start, and is as follows.
LET start() = VALOF { initsdl() mkscreen("First SDL Demo", 600, 400) col_black := col_blue := col_green := col_yellow := col_red := col_majenta := col_cyan := col_white := col_darkgray := col_darkblue := col_darkgreen := col_darkyellow := col_darkred := col_darkmajenta := col_darkcyan := col_gray := col_lightblue := col_lightgreen := col_lightyellow := col_lightred := col_lightmajenta:= col_lightcyan := maprgb( 0, maprgb( 0, maprgb( 0, maprgb( 0, maprgb(255, maprgb(255, maprgb(255, maprgb(255, maprgb( 64, maprgb( 0, maprgb( 0, maprgb( 0, maprgb(128, maprgb( 64, maprgb( 64, maprgb(128, maprgb(128, maprgb(128, maprgb(128, maprgb(255, maprgb(255, maprgb(255, 0, 0, 255, 255, 0, 0, 255, 255, 64, 0, 64, 64, 0, 0, 64, 128, 128, 255, 255, 128, 128, 255, 0) 255) 0) 255) 0) 255) 0) 255) 64) 64) 0) 64) 0) 64) 0) 128) 255) 128) 255) 128) 255) 128)
5.1. INTRODUCTION
109
fillscreen(col_darkgreen) setcolour(col_cyan) plotf(250, 30, "First Demo") setcolour(col_red) moveto( 100, 80) drawby( 400, 0) drawby( 0, -10) drawby(-400, 0) drawby(0, 10) setcolour(col_black) drawfillcircle(250, 100, drawfillcircle(350, 100, setcolour(col_green) drawfillcircle(250, 100, drawfillcircle(350, 100, // Rails
// Wheels 25) 25) 20) 20)
setcolour(col_blue) // Base drawfillrect(200, 110, 400, 130) setcolour(col_majenta) // Boiler drawfillrect(225, 135, 330, 170) setcolour(col_darkred) // Cab drawfillroundrect(340, 135, 400, 210, 15) setcolour(col_lightyellow) drawfillroundrect(350, 170, 380, 200, 10) setcolour(col_lightred) // Funnel drawfillrect(235, 175, 255, 210) setcolour(col_white) drawfillcircle(265, 235, 15) drawfillcircle(295, 250, 12) drawfillcircle(325, 255, 10) drawfillcircle(355, 260, 7) // Smoke
updatescreen() //Update the screen sdldelay(20_000) //Pause for 20 secs closesdl() //Quit SDL RESULTIS 0
110
}
The call initsdl() initialises the SDL system allowing the program to create a window, draw picture in it, interact with the keyboard, mouse, and joystick, if any, and even generate sounds. The call of mkscreen creates a window that is 600 pixels wide and 400 pixels high. It is given the title First SDL Demo. Then follows a sequence of calls to maprgb to create values representing colours in the pixel format used by the system. These calls can only be made after mkwindow has been called. There are several possible pixel formats and is more ecient to use the one that the system is currently using. It turns out that the pixel format on my laptop is dierent from the one used by the Raspberry Pi. The next call fillscreen(col darkgreen) lls the entire window with the specied colour. The call setcolour(...) selects the colour to use in subsequent drawing operations. The rst of which is to draw the string First Demo starting 250 pixels from the left of the window and 30 pixels from the bottom. The convention often adopted in windowing systems is to measure the vertical displacement from the top, but I have adopted the convention that the vertical displacement increases as you move upwards as is typical when drawing graphs on graph paper. If my choice turns out to be too problematic, I will change it and all your pictures will suddenly be upside down. Lines can be drawn in the selected colour by calls such as moveto, drawto, moveby and drawby, which each take a pair of arguments giving either the absolute or relative pixel locations. More complicated shapes can be drawn using functions such as drawcircle(ox, oy, r), drawfillcircle(ox, oy, r), drawrect(x1, y1, x2, y2), drawfillrect(x1, y1, x2, y2), drawroundrect(x1, y1, x2, y2, r) and drawfillroundrect(x1, y1, x2, y2, r). In these calls ox and oy are the coordinates of the centre of the circle and r is its radius. If the function name includes fill, the edge and inside of the shape is lled with the selected colour, otherwise only the edge is drawn. Rectangles can have rounded corners with a radius in pixels given by r. After drawing the picture it can be sent to the display hardware by the call updatescreen(). The call sdldely(20 000) causes a real time delay of 20 seconds so that the image can be viewed, and the nal call closesdl() causes the graphics system to close down.
5.2
The dragon curve
This next demonstration draws the well known dragon curve. The idea is simple. To draw the curve from point A to B , if the distance is less than a certain limit, the curve is just a staight line from A to B , otherwise a detour is made travelling along two sides of a square whose diagonal is AB . If the sides of the square is still too long, detours are again taken, and so on. The detours alternate in
5.2. THE DRAGON CURVE
111
direction, the rst being to the left, the second being to the right and so on. Surprisingly this generates a rather beautiful picture. The following program generates a dragon curve containing 1024 short line segments with a short delay as each line is drawn so you can see the picture being built up. The program is in the le bcplprogs/raspi/dragon.b and is as follows.
GLOBAL { col_blue: ug col_white col_lightcyan } LET start() = VALOF { initsdl() mkscreen("Dragon Curve", 600, 600) col_blue col_white col_lightcyan := maprgb( 0, 0, 255) := maprgb(255, 255, 255) := maprgb(255, 255, 64)
fillscreen(col_blue) setcolour(col_lightcyan) plotf(240, 50, "The Dragon Curve") setcolour(col_white) moveto(260, 200) dragon(1024, 6) updatescreen() sdldelay(20_000) closesdl() RESULTIS 0 } AND bits(w) = w=0 -> 0, 1 + bits(w & w-1) AND gray(n) = n XOR n>>1
112
AND dragon(n, size) BE FOR i = 0 TO n-1 DO { LET dir = bits(gray(i)) & 3 SWITCHON dir INTO { CASE 0: drawby( size, 0); ENDCASE // CASE 1: drawby( 0, size); ENDCASE // CASE 2: drawby(-size, 0); ENDCASE // CASE 3: drawby( 0, -size); ENDCASE // } updatescreen() // Show the curve as it is sdldelay(20) }
Right Up Left Down drawn
When this program runs, it creates a window like the following.
The program uses a cunning trick to determine the direction the ith line segment based on the number of one bits in the gray code representation of i. Gray code has the property that only one binary digit changes as you move from one number to the next. The conversion from ordinary numbers to their gray code representation is done by the function gray, and the number of one bits in
5.3. COLLATZ REVISITED
113
a word is computed by a call of bits. The direction of the next line to draw is determined by the least signicant two bits of this count. Since the count always increases or decreases by one each time, the next line always involves turning left or right by a right angle. I leave it as an exercise for the reader to understand why the result turns out to be the dragon curve.
5.3
Collatz Revisited
The program discribed in this section concerns the Collatz Conjecture which was introduced in Section 4.16 but has been delayed until this point since it generates a graphical image. It draws a graph showing, on the vertical axis, the length in the range 1 to 250 of the Collatz sequences for starting values in the range 1 to 10000 placed on the horizontal axis. The program is called collatzgraph and is as follows.
MANIFEST { nlim = 10000 clim = 250 } GLOBAL { col_red: ug col_green col_blue col_lightgray col_black } LET start() = VALOF { initsdl() mkscreen("Collatz Diagram", 700, 500) col_red col_green col_blue col_lightgray col_black := := := := := maprgb(180, 0, 0) maprgb( 0, 255, 0) maprgb( 0, 0, 255) maprgb(180, 180, 180) maprgb( 0, 0, 0)
114
fillsurf(col_lightgray) // Draw the axes setcolour(col_black) cmoveto( 0, cdrawto(nlim, cdrawto(nlim, cdrawto( 0, cdrawto( 0, 0) 0) clim) clim) 0)
FOR x = 1 TO nlim DO { LET y = try(x) TEST y>=0 THEN setcolour(col_red) ELSE { setcolour(col_blue) y := -y } cdrawpoint(x, y) updatescreen() } sdldelay(20_000) closesdl() RESULTIS 0 } AND cdrawpoint(x,y) BE { // Convert to screen coordinates LET sx = 10 + muldiv(screenxsize-20, x, nlim) LET sy = 10 + muldiv(screenysize-20, y, clim) drawfillcircle(sx, sy, 1) } AND cmoveto(x,y) BE { // Convert to screen coordinates LET sx = 10 + muldiv(screenxsize-20, x, nlim) LET sy = 10 + muldiv(screenysize-20, y, clim) moveto(sx, sy) } AND cdrawto(x,y) BE { // Convert to screen coordinates LET sx = 10 + muldiv(screenxsize-20, x, nlim)
5.4. SDLINFO.B
LET sy = 10 + muldiv(screenysize-20, y, clim) drawto(sx, sy) } AND try(n) = VALOF { LET count = 0 LET lim = (maxint-1)/3 { count := count+1 IF n=1 RESULTIS count TEST n MOD 2 = 0 THEN { n :=n/2 } ELSE { IF n > lim RESULTIS -count n := 3*n+1 } } REPEAT }
115
When this program it compiled and run it generates the following window.
5.4
sdlinfo.b
This section presents a simple program that displays some details of the graphics system. It also displays information about any joysticks that are connected to
116
the system. The program is called sdlinfo.b and is as follows.

/* This program outputs some information about the current SDL interface. Implemented by Martin Richards (c) February 2013 */ GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
GLOBAL { done:ug } LET plotscreen() BE { LET maxy = screenysize-1 // Surface info structure LET flags, fmt, w, h, pitch, pixels, cliprect, refcount = 0, 0, 0, 0, 0, 0, 0, 0 // Format info structure LET palette, bitsperpixel, bytesperpixel, Rmask, Gmask, Bmask, Amask, Rshift, Gshift, Bshift, Ashift, Rloss, Gloss, Bloss, Aloss, colorkey, alpha = 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 // Video info structure LET videoflags, blit_fill, video_mem, videoformat = 0,0,0,0 fillsurf(maprgb(120,120,120)) setcolour(maprgb(255,255,255)) sys(Sys_sdl, sdl_getsurfaceinfo, screen, @flags) sys(Sys_sdl, sdl_getfmtinfo, format, @palette) sys(Sys_sdl, sdl_videoinfo, @videoflags) // Screen surface info plotf(20, maxy- 20, "Screen Surface Info") plotf(30, maxy- 40,
5.4. SDLINFO.B
"flags=%8x w=%n h=%n pitch=%n", flags, w, h, pitch) // Screen format info plotf(20, maxy- 80, "Screen Format Info") plotf(30, maxy-100, "palette=%n bitsperpixel=%n bytesperpixel=%n", palette, bitsperpixel, bytesperpixel) plotf(30, maxy-120, "Rmask=%8x Gmask=%8x Bmask=%8x Amask=%8x", Rmask, Gmask, Bmask, Amask) plotf(30, maxy-140, "Rshift=%n Gshift=%n Bshift=%n Ashift=%n", Rshift, Gshift, Bshift, Ashift) plotf(30, maxy-160, "Rloss=%n Gloss=%n Bloss=%n Aloss=%n", Rloss, Gloss, Bloss, Aloss) plotf(30, maxy-180, "colorkey=%8x alpha=%n", colorkey, alpha) // Video info plotf(20, maxy-220, "Video Info") plotf(30, maxy-240, "videoflags=%8x blit_fill=%8x video_mem=%n", videoflags, blit_fill, video_mem)
117
{ LET n = sys(Sys_sdl, sdl_numjoysticks) plotf(20, maxy-280, "Number of joysticks %2i", n) FOR j = 0 TO n-1 DO { LET joystick = sys(Sys_sdl, sdl_joystickopen, j) LET axes = sys(Sys_sdl, sdl_joysticknumaxes, joystick) LET buttons = sys(Sys_sdl, sdl_joysticknumbuttons, joystick) LET hats = sys(Sys_sdl, sdl_joysticknumhats, joystick) plotf(20, maxy-300-80*j, "Joystick %n", j+1) plotf(30, maxy-320-80*j, "Number of axes %2i", axes) FOR a = 0 TO axes-1 DO plotf(250+60*a, maxy-320-80*j, "%i7", sys(Sys_sdl, sdl_joystickgetaxis, joystick, a)) plotf(30, maxy-340-80*j, "Number of buttons %2i", buttons) FOR b = 0 TO buttons-1 DO plotf(250+20*b, maxy-340-80*j, "%i2", sys(Sys_sdl, sdl_joystickgetbutton, joystick, b))
118

plotf(30, maxy-360-80*j, "Number of hats %2i", hats) FOR h = 0 TO hats-1 DO plotf(250+20*h, maxy-360-80*j, "%b4", sys(Sys_sdl, sdl_joystickgethat, joystick, h)) sys(Sys_sdl, sdl_joystickclose, joystick) }
} } AND processevents() BE WHILE getevent() SWITCHON eventtype INTO { CASE sdle_keydown: CASE sdle_quit: done := TRUE DEFAULT: LOOP } LET start() = VALOF { initsdl() mkscreen("SDL Info", 800, 500) done := FALSE UNTIL done DO { processevents() plotscreen() updatescreen() sdldelay(50) } writef("*nQuitting*n") closesdl() RESULTIS 0 }
The main function start initialises the SDL interface and then makes a window of size 800x500. It then enters an event loop which it repeatedly executes until done is set to TRUE. Within the event loop the call od processevents sets done to TRUE is any key is pressed or if the user clicks on the windows close button. The call of plotscreen interrogates the SDL system and displays some of the information it obtains. It then displays axis, button and hat information about any joysticks that are attached to the system. The call updatescreen() sends the window to the display hardware. The loop ends by delaying for 50 milli-seconds.
5.5. GRAPHS
119
5.5
Graphs
A useful aid to understanding a numerical function is to plot its graph. On graph paper the the point (x, y ) is located at a distance x along the horizontal (x-axis) and a distance y along the vertical (y -axis). The collection of points with coordinates (x, x2 ) gives a curve that shows how x2 changes as we increase x. The following diagram shows the curves for the three functions y = x2 , y = x3 x and y = x3 x2 x displayed in red, green and blue, respectively. The program to draw the graph is as follow.
GLOBAL { col_red: ug col_green col_blue col_lightgray col_black } LET start() = VALOF { initsdl() mkscreen("Three curves", 500, 500) col_red col_green col_blue col_lightgray col_black := := := := := maprgb(255, 0, 0) maprgb( 0, 255, 0) maprgb( 0, 0, 255) maprgb(180, 180, 180) maprgb( 0, 0, 0)
fillsurf(col_lightgray) // We will use scales numbers with three digits after the // decimal point and the $x$ and $y$ ranges will both be // between -3.000 and +3.000 // Draw the axes setcolour(col_black) FOR x = -3_000 TO 3_000 BY 1_000 DO { cmoveto(x, -3_000)
120
cdrawto(x, 3_000) } FOR y = -3_000 TO 3_000 BY 1_000 DO { cmoveto(-3_000, y) cdrawto( 3_000, y) } plotfn(f1, -3_000, 3_000, col_red) plotfn(f2, -3_000, 3_000, col_green) plotfn(f3, -3_000, 3_000, col_blue) updatescreen() sdldelay(20_000) closesdl() RESULTIS 0 } AND plotfn(f, x1, x2, col) BE { setcolour(col) cmoveto(x1, f(x1)) FOR i = 1 TO 100 DO { LET x = (x1*(100-i) + x2*i)/100 cdrawto(x, f(x)) } } AND f1(x) = x*x/3_000 AND f2(x) = f1(x)*x/3_000 - x AND f3(x) = f1(x) - f2(x) AND cmoveto(x,y) BE { // Convert to screen coordinates LET sx = screenxsize/2 + x/15 LET sy = screenysize/2 + y/15 moveto(sx, sy) } AND cdrawto(x,y) BE { // Convert to screen coordinates LET sx = screenxsize/2 + x/15 LET sy = screenysize/2 + y/15 drawto(sx, sy) }
5.6. GRADIENTS This program displays the following window for 20 seconds.
121
5.6
Gradients
The gradient of a function for a given value of x is a measure of how much it changes when x is changed by a tiny amount. Mathematically, we say that the gradient of f (x) is the limit of (f (x + dx) f (x))/dx as dx becomes closer and closer to zero. Mathematicians call the gradient the dierential of f (x) and represent it using the notation: d f ( x) dx Luckily, for many simple functions there are simple formulae allowing us to compute the dierential. For instance, consider the following program (bcplprogs/raspi/slopes.b).
122
GET "libhdr" // This program outputs the approximate slope of y = x^n for // various values of x and n, using scaled numbers with 8 digits // after the decimal point.
LET start() = VALOF { writef(" x try( 1_12345678, try( 1_12345678, newline() try( 0_87654321, try( 0_87654321, newline() try(-0_12345678, try(-0_12345678, RESULTIS 0 }
dx
slope
n**pow(x,n-1)*n*n")
0); try( 1_12345678, 1); try( 1_12345678, 2) 3); try( 1_12345678, 4) 0); try( 0_87654321, 1); try( 0_87654321, 2) 3); try( 0_87654321, 4) 0); try(-0_12345678, 1); try(-0_12345678, 2) 3); try(-0_12345678, 4)
AND try(x, n) BE { LET dx = 0_00010000 LET slope = muldiv(pow(x+dx,n) - pow(x,n), 1_00000000, dx) writef("%11.8d %n %11.8d %11.8d %11.8d*n", x, n, dx, slope, n * pow(x, n-1)) } AND pow(x, n) = VALOF { LET xn = 1_00000000 FOR i = 1 TO n DO xn := muldiv(xn, x, 1_00000000) RESULTIS xn }
When run, it outputs the following.

x 1.12345678 1.12345678 1.12345678 1.12345678 1.12345678 n 0 1 2 3 4 dx 0.00010000 0.00010000 0.00010000 0.00010000 0.00010000 slope 0.00000000 1.00000000 2.24700000 3.78680000 5.67260000 n*pow(x,n-1) 0.00000000 1.00000000 2.24691356 3.78646539 5.67190692
5.6. GRADIENTS
0.87654321 0.87654321 0.87654321 0.87654321 0.87654321 -0.12345678 -0.12345678 -0.12345678 -0.12345678 -0.12345678 0 1 2 3 4 0 1 2 3 4 0.00010000 0.00010000 0.00010000 0.00010000 0.00010000 0.00000000 1.00000000 1.75320000 2.30520000 2.69430000 0.00000000 1.00000000 1.75308642 2.30498397 2.69389072 0.00000000 1.00000000 -0.24691356 0.04572471 -0.00752668
123
0.00010000 0.00000000 0.00010000 1.00000000 0.00010000 -0.24680000 0.00010000 0.04570000 0.00010000 -0.00750000
This seems to imply that d n x = n xn1 dx We can convince ourselves that this is indeed correct by the following derivation.
d n x dx
= =
= = nx + O(dx) n1 = nx
((x+dx)(x+dx)...(x+dx))xn dx xn +nxn1 dx+O(dx2 )xn dx nxn1 dx+O(dx2 ) dx n1
where the notation O(dx) stands for terms that all have dx as a factor, so tend to zero as dx becomes smaller and smaller. Using this formula we can easily see that
d xn ( ) dx n!
= =
nxn1 n! xn1 (n1)!
This allows us to deduce a remarkable property of ex , namely

d x e dx
d (1 dx
+x+
= 0+1+x = ex
3 4 x2 +x +x + 2! 3! 4! 2 3 +x +x + ... 2! 3!
. . .)
124
5.7
Events
This section demonstrates how input from the keyboard, mouse and joystick can be handled. The program displays a coloured circle in a window. Its colour may be changed to red, green or blue by pressing R, G or B on the keyboard, or by buttons on the joystick. It can be moved up, down, left or right by pressing the arrow keys, and it may be dragged using the mouse with a mouse button pressed. It may also be moved using the joystick. You can exit from the program by pressing Q. The program starts as follows.
GLOBAL { done:ug xpos; ypos; xdot; ydot col_blue; col_green; col_red col_cyan; col_white; col_gray } LET start() = VALOF { initsdl() mkscreen("Events Test", 600, 400) runtest() closesdl() RESULTIS 0 }
As usual we insert a section containing the BCPL interface to the SDL library, and declare the global variables required by the program. The main function start initialises the SDL system and make a window of size 600 by 400 entitled Events Test before calling runtest, dened below, and the call closesdl closes down the SDL library.
AND runtest() = VALOF { // Declare a few colours in the pixel format of the screen col_blue := maprgb( 0, 0, 255) col_green := maprgb( 0, 255, 0) col_red := maprgb(255, 0, 0)
5.7. EVENTS
col_cyan col_white col_gray := maprgb(255, 255, 0) := maprgb(255, 255, 255) := maprgb(128, 128, 128)
125
fillscreen(col_gray) xpos, ypos := 1000*screenxsize/2, 1000*screenysize/2 xdot, ydot := 0, 0 setcolour(col_red) // Set the initial circle colour done := FALSE UNTIL done DO { step() displayall() sdldelay(20) } RESULTIS 0 }
runtest creates a few colours, lls the screen with a gray colour and initialises, xpos, ypos , xdot, ydot and done. The rst two are scaled numbers with three digits after the decimal point representing the coordinates on the screen of the location of the small coloured circle. Mathematicians often use the notation x and y to represent the rate at which x and y change with time. In this program we use the names xdot and ydot to hold the rate of change of xpos and ypos. These rates depend on the joystick position. The variable done is set to TRUE when the user wishes to exit from the program. The program now enters an UNTIL loop that repeatedly reads and processes events from the keyboard, mouse and joystick. These events may change the colour and position of the coloured circle, so the window is redrawn by the call displayall() each time round the loop. The call sdldelay(20) causes a real time delay of 20 milli-seconds so that the screen is updated about 50 times per second independent of the CPU speed of the computer. The program thus has a similar timing behaviour even when run on computers of dierent processing power. Finally the denition of step is as follows.
AND step() BE { WHILE getevent() SWITCHON eventtype INTO { DEFAULT: LOOP CASE sdle_keydown: SWITCHON capitalch(eventa2) INTO
126

{ DEFAULT: CASE CASE CASE CASE CASE CASE CASE CASE } CASE sdle_keyup: CASE sdle_mousemotion: UNLESS eventa1 LOOP CASE sdle_mousebuttonup: CASE sdle_mousebuttondown: xpos, ypos := 1000*eventa2, 1000*(screenysize-eventa3) LOOP CASE sdle_joyaxismotion: SWITCHON eventa2 INTO // Which axis { DEFAULT: LOOP CASE 0: xdot := +eventa3/2; LOOP // Aileron CASE 1: ydot := -eventa3/2; LOOP // Elevator } CASE sdle_joybuttonup: CASE sdle_joybuttondown: SWITCHON eventa2 INTO { DEFAULT: CASE 0: setcolour(col_red); CASE 1: setcolour(col_blue); CASE 2: setcolour(col_green); } LOOP LOOP sdle_arrowup: sdle_arrowdown: sdle_arrowright: sdle_arrowleft: R: G: B: Q: ypos ypos xpos xpos := := := := ypos+8_000; ypos-8_000; xpos+8_000; xpos-8_000; LOOP LOOP LOOP LOOP LOOP LOOP LOOP LOOP LOOP
setcolour(col_red); setcolour(col_green); setcolour(col_blue); done := TRUE;
LOOP LOOP LOOP
CASE sdle_quit: done := TRUE; } xpos, ypos := xpos+xdot, ypos+ydot }
LOOP
When the user presses a key on the keyboard, moves the mouse or joystick, or
5.7. EVENTS
127
presses a mouse or joystick button, the system creates an event held in an event queue. These events can be inspected, one at a time, by calling getevent(). If there are no outstanding events getevent returns FALSE, otherwise it updates the global variable eventtype and possibly some event arguments eventa1, eventa2, eventa3, etc. As we will see later, which event arguments are set depends on the the event type. The possible event types are declared in sdl.h and have names starting with sdle , such as sdle keydown or sdle joyaxismotion. If the type was sdle keydown, the argument eventa2 will identify which key pressed. As can be seen, the program is only interested in the arrow keys and the letters R, G, B and Q. The arrow keys cause the coordinates xpos and ypos to change, R, G, B cause the colour of the circle to change and Q sets done to TRUE causing execution of the program to terminate. If the type was sdle mousebuttondown, the arguments eventa2 and eventa3 give the coordinates of the mouse. These are used to set the coordinates of the centre of the coloured circle. If the type was sdle mousemotion, the arguments eventa2 and eventa3 give the coordinates of the mouse. eventa1 is a bit pattern identifying which of the mouse buttons are currently pressed, and if any are, the coloured circle is moved to the cursor position. If the type was sdle joyaxismotion, the arguments eventa2 and eventa3 identify which axis has moved and what it new value is. With the Logitech Attack 3 joystick there are three axes, elevator, aileron and throttle and their values range from -32768 to +32767. The elevator and aileron values are used to control how fast our coloured circle moves across the screen. The event type sdle quit occurs when the user clicks on the little cross at the top right hand corner of the window indicating that the program should terminate. All that step does in this case is to set done to TRUE causing execution to leave the event loop. The nal function, displayall, just lls the screen with gray, draws the coloured circle in it new position, ensuring that it is still within the window, and nally displayall calls updatescreen to update the video hardware. Its denition is as follows.
AND displayall() BE { LET x, y = xpos/1000, ypos/1000 LET minx, miny = 20, 20 LET maxx, maxy = screenxsize-20, screenysize-20 fillscreen(col_gray) IF IF IF IF x<minx y<miny x>maxx y>maxy DO DO DO DO x, y, x, y, xpos ypos xpos ypos := := := := minx, miny, maxx, maxy, minx*1000 miny*1000 maxx*1000 maxy*1000
128
drawfillcircle(x, y, 20) updatescreen() }
5.8
eix and rotation
We all know that when we square a number the result is positive. For example, 22 = 4 and (3)2 = 9. But mathematicians are not satised with this since they sometimes nd it useful to take the square root of negative numbers. You might think they are mad but let us see what they do and why it is useful. The trick is to postulate a new number i having the property that i2 = 1. Such a number, of course, cannot exist so they call it an imaginary number. They let it obey all the normal algebraic rules that ordinary (real) numbers have. Using i we can make complex numbers such as 2 + 3i, and these also obey the normal rules of algebra. For instance, we can multiply them as in (a + ib) (c + id) = ac + i2 bd + aid + ibc = (ac bd) + i(ad + bc) We have seen the series for ex in Section 4.21 which was as follows ex = 1 + x +
x2 2!
x3 3!
+ ...
If we substitute ix for x in this equation we get an equation with some very interesting properties. eix = 1 + ix +
i 2 x2 2!
2
i 3 x3 3!
3
+
4
i 4 x4 4!
+
5
i 5 x5 5!
+ ...
= 1 + ix x ix +x + ix + ... 2! 3! 4! 5! 2 4 5 x x x3 = (1 2! + 4! + . . .) + i(x 3! + x + . . .) 5! The real and imaginary parts of eix are so important they are given the names cosine and sine, normally written as cos x and sin x. cos x = 1 sin x = x
x2 2! x3 3!
+ +
x4 4! x5 5!
+ ... + ...
Notice that if we change the sign of x, all the terms in the cos series remain unchanged, but those in the sin series are all negated, so
5.8. E IX AND ROTATION cos(x) = cos x sin(x) = sin x Notice, also, that eix eix = eixix = e0 = 1 But eix eix
129
= (cos x + i sin x) (cos(x) + i sin(x)) = (cos x cos(x) sin x sin(x)) + i(cos x sin(x) sin x cos(x)) = (cos2 x + sin2 x) + i( cos x sin x + sin x cos x) = cos2 x + sin2 x
So cos2 x + sin2 x = 1 Using the formula

d xn ( ) dx n!
xn1 (n1)!
that we derived earlier, we can easily obtain the following two results.
d sin x dx
= = =
3 5 d (x x +x + dx 3! 5! x2 x4 1 2! + 4! + . . .
. . .)
cos x
and
d cos x dx
d (1 dx
x2 2!
x4 4!
x6 6!
+ . . .)
= x + 3! = sin x
x3
x5 5!
+ . . .)
130
It turns out that the arguments of cos and sin are best thought of as angles and, since mathematicians like to use greek letters for angles, we will use letters such as and in place of x and y , saving x and y for horizontal and vertical coordinates on graph paper. It is instructive to see how cos and sin as changes from 0 to 2 . The following program plots them with the curve for cos in red and the curve for sin in green. It also plots the points with coordinate (cos , sin ) in blue centred on the graph. The program uses variants of several of the functions used in the 163 evaluation of e given in Section 4.22, and as with the previous program we use multi digit numbers of radix 10000 held in vectors, but this time the upper bound is 4 which is sucient for a precision of nearly 16 decimal digits after the decimal point. If v is such a number, then 10000*v!0+v!1 is the equivalent scaled xed point number with 4 decimal digits after the decimal point. The digit in v!0 is signed, but all the other digits are positive in the range 0 to 9999. This convention is somewhat analagous to the interpretation of the bits in a 2s complement signed binary numbers. The program (which is in bcplprogs/raspi/cossin.b) starts as follows.
// Insert the SDL library source code as a separate section GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
GLOBAL { x0:ug // The scaling parameters y0 scale col_white; col_blue; col_green; col_red; col_gray; col_black } MANIFEST { upb = 4 } LET start() = VALOF { initsdl() mkscreen("Cosine and sine curves", 800, 400) // Declare a col_white := col_black := col_blue := few colours in the pixel format of the screen maprgb(255, 255, 255) maprgb( 0, 0, 0) maprgb( 0, 0, 225)
5.8. E IX AND ROTATION

col_green := maprgb( 0, 185, 0) col_red := maprgb(195, 0, 0) col_gray := maprgb(228, 228, 228) fillscreen(col_gray) updatescreen() //Update the screen hardware setscaling() // Set the scaling parameters for smoveto etc. plotgraphpaper() plot_fn(cosine) plot_fn(sine) plotcircle()
131
setcolour(col_black); setcolour(col_red); setcolour(col_green); setcolour(col_blue);
updatescreen() //Update the screen hardware sdldelay(20_000) //Pause for 20 secs closesdl() RESULTIS 0 }
All that remains is to dene the plotting functions and the one that sets the scaling parameters so that the graph will appear appropriately sized and centred in the window. The graph paper ranges from 0.0000 to 3.1415 in the x (horizontal) direction and from -1.0000 to +1.0000 in the y (vertical) direction with (0, -1) being the bottom left corner of the graph. Lines will be drawn using the functions smoveto and sdrawto which both take scaled xed point numbers with 4 digits after the decimal point to specify the coordinate on the graph paper. They are dened as follows.
AND smoveto(x, y) BE { LET screenx = x0 + muldiv(x, scale, 1_000_000) AND screeny = y0 + muldiv(y, scale, 1_000_000) moveto(screenx, screeny) } AND sdrawto(x, y) BE { LET screenx = x0 + muldiv(x, AND screeny = y0 + muldiv(y, drawto(screenx, screeny) updatescreen() //Update the sdldelay(20) // So we can }
scale, 1_000_000) scale, 1_000_000) screen see the curves being drawn
132
Both these functions use the scaling parameters x0, y0 and scale to transform the graph paper coordinates to coordinates on the window. Notice also that sdrawto updates the screen and has a slight real time delay so that we can watch the graphs being drawn. The scaling parameters are set by the next function
AND setscaling() BE { // Set the scaling parameters x0, y0 and scale used by smoveto // and sdrawto so that the drawing area from x = 0 to 2 pi and // y = -1.0 to +1.0 appears centered in the window. // The convertion from graph coordinates (x, y) to // screen coordinates will be as follows // screenx = x0 + muldiv(x, scale, 1_000_000) // screeny = y0 + muldiv(y, scale, 1_000_000) x0 := screenxsize / 20 y0 := screenysize / 2 scale := muldiv(screenxsize*9/10, 1_000_000, 2 * 3_1415) }
Next comes the plotting functions. The rst draws the graph paper consisting of lines for the edges, the x axis and vertical lines at /2, and 3/2.
AND plotgraphpaper() BE { FOR i = -1 TO +1 DO { // Draw horizontal lines at -1.0000, 0 and 1.0000 smoveto( 0, i * 1_0000) sdrawto( 2*3_1415, i * 1_0000) } FOR i = 0 TO 4 DO { // Draw vertical lines at 0, pi/2, pi 3pi/2 and 2pi smoveto( i*3_1415/2, -1_0000) sdrawto( i*3_1415/2, +1_0000) } }
The next function plot fn is used to plot the cosine and sine curves. It takes an argument f which is either cosine or sine and draws the curve as a sequence of 100 short line segments. It uses a multi digit representation of the angle theta which it passes to f each time a new value is to be computed. The values of are of the form 2n/100 for n in the range 0 to 100. It uses mulbyk and divbyk dened later.

AND plot_fn(f) BE FOR n = 0 TO 100 DO { // Plot f(theta) from theta = 0 to 2 pi LET theta = VEC upb LET pi = TABLE 3,1415,9265,3589,7932 FOR j = 0 TO upb DO theta!j := pi!j // Set theta = pi mulbyk(theta, 2*n) divbyk(theta, 100) TEST n=0 THEN smoveto(10000*theta!0+theta!1, f(theta)) ELSE sdrawto(10000*theta!0+theta!1, f(theta)) }
133
The function plotcircle has much in common with plot fn but draws short line segements between point with coordinates (cos , sin ). A scaled number representing 3.1415 is added to the x coordinate to place the circle at the center of the graph.
AND plotcircle() BE FOR n = 0 TO 100 DO { LET theta = VEC upb LET pi = TABLE 3,1415,9265,3589,7932 FOR i = 0 TO upb DO theta!i := pi!i // Set theta = pi mulbyk(theta, 2*n) divbyk(theta, 100) TEST n=0 THEN smoveto(cosine(theta)+3_1415, sine(theta)) ELSE sdrawto(cosine(theta)+3_1415, sine(theta)) }
The functions cosine and sine compute multi digit representations of cos and sin using the two series we have already seen, namely. cos x = 1 sin x = x
x2 2! x3 3!
+ +
x4 4! x5 5!
+ ... + ...
Since these series have much in common, cosine and sine both use an auxiliary function sumseries(theta, n) to perform the summation. theta is a multi digit representation of and n=0 for cosine and n=1 for sine. The function is dened as follows.
AND sumseries(theta, n) = VALOF { // n=0 return cosine theta as a scaled number with 4 decimal // digits after the decimal point
134
// n=1 return sine theta as a scaled number with 4 decimal // digits after the decimal point LET sum = VEC upb LET term = VEC upb // Next term to add, x^n/n! LET negt2 = VEC upb // To hold -theta^2 FOR i = 0 TO upb DO sum!i, term!i := 0, 0 // Set sum and term to zero term!0 := 1 // Set sum to 1.0000 IF n DO mult(term, term, theta) FOR i = 0 TO upb DO negt2!i := theta!i mult(negt2, negt2, negt2) neg(negt2, negt2) // Set term for sine // Set negt2 = theta // negt2 now holds theta^2 // negt2 now hold -theta^2
UNTIL iszero(term) DO { add(sum, sum, term) // Accumulate the current term mult(term, term, negt2) // Calculate the next term in the series divbyk(term, n+1) divbyk(term, n+2) n := n+2 } RESULTIS 1_0000*sum!0 + sum!1 // Return a fix point scaled number } AND iszero(v) = VALOF { FOR i = 0 TO upb IF v!i RESULTIS FALSE RESULTIS TRUE }
The denition of sumseries should be reasonable understandable. It accumulates the result in sum by adding the next term (held in term) until term represents zero. 2 The next term is computed from the previous one by multiplying by (n+1)( n+2) incrementing n by 2 each time. The initial value of term represents either 1 for cosine or for sine. Once the series has been summed, it is converted to a scaled xed point number with 4 decimal digits after the decimal point by the expression 1_0000*sum!0 + sum!1. Finally cosine as sine are dened by suitable calls of sumseries.
AND cosine(theta) = sumseries(theta, 0) AND sine(theta) = sumseries(theta, 1)
135
All that remains is to dene the low level functions to perform arithmetic on our multi digit representation of signed numbers. The rst of these is mult which computes the product of the numbers in y and z storing the result in x. The comments explain how it works.
AND mult(x, y, z) BE { // Set x to the product of y and z // x, y and z need not be distinct, so copies are made. LET res = VEC upb+3 // res includes some guard digits LET cy = VEC upb // cy and cz will hold copies of y and z LET cz = VEC upb LET resneg = FALSE // Make copies of y and z FOR i = 0 TO upb DO cy!i, cz!i := y!i, z!i // Set res to zero FOR i = 0 TO upb+3 DO res!i := 0 // Rounding of the result is done by adding 1/2 to the last digit res!(upb+1) := 5000 IF cy!0<0 DO { neg(cy, cy); resneg := ~resneg } IF cz!0<0 DO { neg(cz, cz); resneg := ~resneg } // cy and cz now both reprent positive numbers FOR i = 0 TO upb IF cy!i FOR j = 0 TO upb+3-i DO { LET p = i + j // Destination in range 0 to upb+3 LET d = res!p + cy!i * cz!j LET carry = d / 10000 IF p=0 DO { res!0 := d; LOOP } // res!0 is allowed to be >= 10000 res!p := d MOD 10000 // Deal with the carry, if any WHILE carry DO { p := p-1 // Position of next digit to the left d := res!p + carry IF p=0 DO { res!0 := d; BREAK } carry := d / 10000 res!p := d MOD 10000 } } TEST resneg THEN neg(x, res) ELSE FOR i = 0 TO upb DO x!i := res!i }
// Set x = -res // Set x = res
136
The next function copies the negated value of y into x. It is perhaps best understood by considering the operation on a number with only one digit (of radix 10000) after the decimal point. Suppose num represents 1.2345, then num!0=1 and num!1=2345. Our representation -1.2345 has num!0=-2 and num!1=7655 since the fractional part is positive. This result can be computed as follows. First negate both the integer and fractional parts giving num!0=-1 and num!1=-2345, then correct the fractional part by adding 10000 to it and subtracting 1 from the integer part in compensation. The addition 10000 can be done by adding 9999 and then incrementing the result. The fractional part thus becomes 9999-2345+1 = 7654+1 = 7655. Note that the addition of 1 causes a carry of 1 into the integer part, if the original fractional part was zero.
AND neg(x, y) BE { // Set x to -y LET carry = 1 FOR i = upb TO 1 BY -1 DO { LET d = 9999 - y!i + carry x!i := d MOD 10000 carry := d / 10000 } x!0 := carry - y!0 -1 }
The add function adds corresponding digits of y and z starting from the least signicant end, dealing with carries as it goes. The result is placed in x. Note that the fraction digits are all positive but the integer part (in element zero) is signed and need not be in the range -9999 to +9999.
AND add(x, y, z) BE { LET carry = 0 FOR i = upb TO 1 BY -1 DO { LET d = y!i + z!i + carry x!i := d MOD 10000 carry := d / 10000 } x!0 := y!0 + z!0 + carry }
Subtraction is performed by negating z then calling add.

AND sub(x, y, z) BE { // Set x = y - z // Copy z because it might be the same as y

LET cz = VEC upb neg(cz, z) add(x, y, cz) }
137
The function mulbyk multiplies the multi digit signed number in v by the integer k placing the result back in v. It conditionally changes the signs of v and k so the multiplication is performed on positive values. It then changes the sign of v again at the end, if needed.
AND mulbyk(v, k) BE { LET carry = 0 LET resneg = FALSE IF v!0<0 DO { neg(v, v); resneg := ~resneg } IF k<0 DO { k := -k; resneg := ~resneg } FOR i = upb TO 1 BY -1 DO { LET d = v!i * k + carry v!i := d MOD 10000 carry := d / 10000 } v!0 := v!0 * k + carry IF resneg DO neg(v, v) }
The function divbyk divides the multi digit signed number in v by the integer k placing the result back in v.
AND divbyk(v, k) BE { LET carry = 0 LET resneg = FALSE IF v!0<0 DO { neg(v, v); resneg := ~resneg } IF k<0 DO { k := -k; resneg := ~resneg } FOR i = 0 TO upb DO { LET d = carry*10000 + v!i v!i := d / k carry := d MOD k } IF resneg DO neg(v, v) }
138
When the above program runs, it creates the window shown below containing the curves for cos in red, sin in green and a circle in blue. The short delay in sdrawto allows you to see these curves being drawn.
Before leaving this section, there is one last formula we need to derive. Looking at the blue circle drawn by the previous program, it is clear the coordinates (cos , sin ) lie on a circle of radius one. is not measured in degrees but in radians which is the distance around the circumference of the unit circle from the point (1, 0). Thus = 2 corresponds to an angle of 360o . Let us assume a point P on the unit circle is at an angle from the x axis and that its coordinates are (x, y ) = (cos , sin ). If we wanted to rotate P anticlockwise by an angle to point Q, it would move to (X, Y ) = (cos( + ), sin( + )). It would be really useful to have formulae that compute these coordinates in terms of the old ones and , and this can easily be done by considering ei(+) as follows ei(+) = cos( + ) + i sin( + ) But also ei(+) = ei ei = (cos + i sin ) (cos + i sin ) = (cos cos sin sin ) + i(sin cos + cos sin ) So cos( + ) = cos cos sin sin sin( + ) = sin cos + cos sin
139
Remembering the old coordiates were (x, y ) = (cos , sin ), we can calculate the new coordinates (X, Y ) = (cos( + ), sin( + )) as follows X Y = cos x sin y = sin x + cos y
Mathematicians usually prefer to write these two equations as a single equation have exactly the same meaning using what is called matrix notation.
X Y
cos sin sin cos
x y
It is easy to see that these formulae work just as well when (x, y ) is not on the unit circle but on a circle of radius r, say. These formulae will be used later when we wish to rotate, for example, the moon lander space craft. To see a geometric proof of the cos( + ) equation do a web search on: cos a plus b geometric proof. 2 and Note that when is small enough to allow us to ignore terms such as 2! 3 then from the series we can deduce that cos is approximately 1 and sin is 3! approximately . We take advantage of these approximations when dealing with small rotations in implementation of the ight simulator given later. To summarise this section, we started by considering the impossible number i whose square is -1 and then thought of the equally mind boggling idea of computing eix , that is multiplying 1 by e, ix times. This resulted in two functions, cos and sin, which, when plotted, looked beautiful and rather similar. We even showed that cos2 + sin2 = 1 which was conrmed by plotting points of the form (cos , sin ) showing they all lay on the unit circle. We went on to deduce formulae for cos( + ) and sin( + ) which we will be used later in this chapter. What this tells us is that mathematics in not just about learning multiplication tables and doing tedious numerical sums, but is more to do with extraordinary ideas and beautiful results obtained with the aid of a little simple algebra. Some of the results turn out to be very useful, while others, like Eulers identity ei +1 = 0, are just wonderous to observe. (Try a web search on: e to the i pi plus one equals zero.) If you have reached this far in this section you are either already a mathematician or well on the way to becoming one. Well done!
140
5.9
Ball and Bucket Game
This is a simple game in which the user can hit three coloured balls with a bat in an enclosed room which has a bucket placed near the ceiling. The balls bounce o each other, the walls, the oor, the ceiling and the bat, and feel the eect of gravity. The bat can only move horizontally along the oor and its motion is controlled by the left and right arrow keys. Pressing R puts all three balls in the bucket and pressing S starts the game by removing the base of the bucket until the balls fall out. Pressing P pauses the game, and Q will cause the game to terminate. Pressing H will toggle the display of some help information, and pressing D or U will cause debugging and CPU usage information to be displayed. The aim of the game is to return the balls to the bucket as quickly as you can. A typical screen shot is the following.
The source of the program is in bplprogs/raspi/bucket.b and, although quite long, most of it is easy to understand. There is code to display the static parts of the scene, namely, the bucket walls with their rounded ends and the base of the bucket. There is code to display the three balls and the bat in their current positions. There is code to deal with bouncing of the balls o each other and the bat as well as bounces o xed surfaces such as the walls and the bucket. The game is controlled by input from the keyboard and mouse, handled by the function processevents. The program starts as follows.
/* This is a simple bat and ball game Implemented by Martin Richards (c) February 2013 History:
5.9. BALL AND BUCKET GAME
141
17/02/2013 Successfully reimplemented the first version, bucket0.b, to make it much more efficient. */ GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
MANIFEST { >
1_00000 // The constant 1.000 scaled with 5 decimal // digits after the decimal point. batradius ballradius endradius bucketthickness ag = 50_00000 = = = = 15_00000 25_00000 15_00000 2 * endradius // Gravity acceleration
} GLOBAL { done:ug help stepping starting started finished randombat randbattime randbatx // Display help information // =FALSE if not stepping // Trap door open
// If TRUE the bat is given random accelerations
starttime // Set when starting becomes FALSE displaytime // Time to display usage displayusage debugging sps // Steps per second, adjusted automatically
142
bucketwallsurf bucketbasesurf ball1surf ball2surf ball3surf batsurf
// Surface for the bucket walls // Surface for the bucket base // Surfaces for the three balls
// Surface for the bat
backcolour // Background colour bucketcolour bucketendcolour ball1colour ball2colour ball3colour batcolour wall_lx wall_rx floor_yt ceiling_yb screen_xc bucket_lxl; bucket_rxl; bucket_tyb; bucket_byb; bucket_lxc; bucket_rxc; bucket_tyc; bucket_byc; bucket_lxr bucket_rxr bucket_tyt bucket_byt // // // // Bucket Bucket Bucket Bucket left wall right wall top base // // // // Left wall Right wall Floor Ceiling
// Ball bounce limits xlim_lwall; xlim_rwall ylim_floor; ylim_ceiling xlim_bucket_ll; xlim_bucket_lc; xlim_bucket_lr xlim_bucket_rl; xlim_bucket_rc; xlim_bucket_rr ylim_topt ylim_baseb; ylim_baset ylim_bat // Positions, velocities and cgx1; cgy1; cgx1dot; cgy1dot; cgx2; cgy2; cgx2dot; cgy2dot; cgx3; cgy3; cgx3dot; cgy3dot; accelerations of the balls ax1; ay1 ax2; ay2 ax3; ay3
// Positions, velocities and accelerations of the balls batx; baty; batxdot; batydot; abatx; abaty }
143
The rst four lines insert the BCPL interface with the SDL library. This is followed by the declarations of the constants and global variables used in the program. Many quantities in this program use scaled numbers with 5 decimal digits after the decimal point. These numbers are used for the location of the xed surfaces on the screen, the centre of gravity of the balls and bat, and their velocities and accelerations. The constant One represents 1.00000 in this representation. The radii of the balls and bat are held in ballradius and batradius. The bucket has circular corners whose radius is in endradius. The thickness of the bucket walls and the base is twice endradius and is held in bucketthickness. The balls feel the eect of gravity whose acceleration is held in ag, typically set to 50 00000 representing 50 pixels per second per second. The player can terminate the program by pressing Q or clicking on the little cross at the top right hand corner of the window. This sets the variable done to TRUE. Various variables, such as starting, started and finished, describe the state of the game. For instance, starting=TRUE after the player presses S to place the the balls in the bucket and remove its base allowing them to fall out. When the bucket becomes empty the base is re-instated and started becomes TRUE. This is the moment when the timer is started and begins to be displayed. When all three balls are returned to the bucket, finished is set to TRUE and the timer is stopped. Pressing B causes the program to move the bat randomly causing the balls to be eventually returned to the bucket. It is implemented using the variables randombat, randbattime and randbatx. Details are given later. Pressing P causes the program to pause. It is implemented by setting stepping to FALSE. Pressing D or U turn on and o the display of some debugging information. The colour of the various objects on the screen such as the bucket, bat and balls are held in suitably mnemonic variables such as bucketycolour and batcolour. Many variables are initialised to hold the geometry of the objects in the game. For instance wall lx and wall rx hold the x coordinates of the left and right wall. The y -coordinates of the ceiling and oor are held in ceiling yb and floor yt. The x-coordinate of the centre of the screen is held in screen xc. Variables starting bucket hold the coordinates of the surfaces of the bucket. Global variables with names starting with xlim or ylim are used to determine eciently whether a ball is in contact with a xed surface such as the side of the bucket. The position, velocity and acceleration of the balls are held in variables such as cgx1, cgy1, cgx1dot, cgy1dot, ax1 and ay1. It is important that these six values are in consecutive global locations since @cgx1 is sometimes used as a pointer to all six values.
144
The bat is constrained to move horizontally in contact with the oor, but it is convenient to represent its position and velocity using the variables batx, baty, batxdot and batydot. When the bat is being moved randomly, the variable abatx holds its current acceleration. An important feature of the game is how the balls bounce. Bouncing o at surfaces such as the oor or sides of the bucket is straightforward since they are all either horizontal or vertical. Details of such bounces are covered later. When a ball collides with another ball, the bat or a circular corner of the bucket, the computation is more dicult. The two functions incontact and cbounce help to deal with these collisions. incontact is dened as follows.
LET incontact(p1,p2, d) = VALOF { LET x1, y1 = p1!0, p1!1 LET x2, y2 = p2!0, p2!1 // (x1,y1) and (x2,y2) are the centres of two circles // The result is TRUE if these centres are less than d apart. LET dx, dy = x1-x2, y1-y2 IF ABS dx > d | ABS dy > d RESULTIS FALSE IF muldiv(dx,dx,One) + muldiv(dy,dy,One) > muldiv(d,d,One) RESULTIS FALSE RESULTIS TRUE }
The variable x1, y1, x2 and y2 are declared to hold the centres of the two circles, and the function returns TRUE if these circles are less than a distance d apart. The argument d is the sum of the radii of the two cicles involved, and so is batradius+ballradius, endradius+ballradius, ballradius+ballradius. With the current settings d can be no larger than 50 00000. The function rst checks whether the horizontal and vertical separations of the two objects are no greater than d. This is a cheap test and has the merit that the more detailed measurement of separation cannot suer from overow. The distance between the two centres is the length of the hypotenuse of a right angled triangle whose shorter sides have lengths dx and dy. Using Pythagorus theorem the square of this length is the sum of squares of dx and dy, and so we compare this sum with the square of d, dividing both sides of the relation by 00000 to avoid overow. Notice that both dx and dy are less than or equal to 50 00000 and so muldiv(dx,dx,One) + muldiv(dy,dy,One) can be no greater than twice 2500 00000 which is well within the range of 32-bit signed numbers. A bounce between these two objects can only occur if incontact returns TRUE. The eect of the collision is calculated by a call of cbounce whose denition is as follows.
AND cbounce(p1, p2, m1, m2) BE { // p1!0 and p1!1 are the x and y coordinates of a ball, bat or bucket end.

// // // // // // // //
145
p1!2 and p1!3 are the corresponding velocities p2!0 and p2!1 are the x and y coordinates of a ball. p2!2 and p2!3 are the corresponding velocities m1 and m2 are the masses of the two objects in arbitrary units m2 = 0 if p1 is a bucket end. m1=m2 if the collition is between two balls m1=5 and m2=1 is for collisions between the bat and ball assuming the bat has five times the mass of the ball.
LET c = cosines(p2!0-p1!0, p2!1-p1!1) // Direction p1 to p2 LET s = result2 IF m2=0 DO { // Object 1 is fixed, ie a bucket corner LET xdot = p2!2 LET ydot = p2!3 // Transform to (t,w) coordinates // where t is in the direction of the two centres LET tdot = inprod(xdot,ydot, c, s) LET wdot = inprod(xdot,ydot, -s, c) IF tdot>0 RETURN // Object 2 is getting closer so reverse tdot (but not wdot) // and transform back to world (x,y) coordinates. tdot := rebound(tdot) // Reverse tdot with some loss of energy p2!2 := inprod(tdot, wdot, c, -s) p2!3 := inprod(tdot, wdot, s, c) RETURN } IF m1=m2 DO { // Objects 1 and 2 are both balls of equal mass // Find the velocity of the centre of gravity LET cgxdot = (p1!2+p2!2)/2 LET cgydot = (p1!3+p2!3)/2 // Calculate the velocity of object 1 // relative to the centre of gravity LET rx1dot = p1!2 - cgxdot LET ry1dot = p1!3 - cgydot // Transform to (t,w) coordinates LET t1dot = inprod(rx1dot,ry1dot, c,s) LET w1dot = inprod(rx1dot,ry1dot, -s,c)
146

IF t1dot<=0 RETURN // Reverse t1dot with some loss of energy t1dot := rebound(t1dot) // Transform back to (x,y) coordinates relative to cg rx1dot := inprod(t1dot,w1dot, c,-s) ry1dot := inprod(t1dot,w1dot, s, c) // Convert to world (x,y) coordinates p1!2 := rx1dot + cgxdot p1!3 := ry1dot + cgydot p2!2 := -rx1dot + cgxdot p2!3 := -ry1dot + cgydot // Apply a small repulsive force between balls p1!0 := p1!0 - muldiv(0_40000, c, One) p1!1 := p1!1 - muldiv(0_40000, s, One) p2!0 := p2!0 + muldiv(0_40000, c, One) p2!1 := p2!1 + muldiv(0_40000, s, One) RETURN
} { // Object 1 is the bat and object 2 is a ball // Find the velocity of the centre of gravity LET cgxdot = (p1!2*m1+p2!2*m2)/(m1+m2) LET cgydot = (p1!3*m1+p2!3*m2)/(m1+m2) // Calculate the velocities of the two objects // relative to the centre of gravity LET rx1dot = p1!2 - cgxdot LET ry1dot = p1!3 - cgydot LET rx2dot = p2!2 - cgxdot LET ry2dot = p2!3 - cgydot // Transform to (t,w) coordinates LET t1dot = inprod(rx1dot,ry1dot, c,s) LET w1dot = inprod(rx1dot,ry1dot, -s,c) LET t2dot = inprod(rx2dot,ry2dot, c,s) LET w2dot = inprod(rx2dot,ry2dot, -s,c) IF t1dot<=0 RETURN // Reverse t1dot and t2dot with some loss of energy t1dot := rebound(t1dot) t2dot := rebound(t2dot)
147
// Transform back to (x,y) coordinates relative to cg rx1dot := inprod(t1dot,w1dot, c,-s) ry1dot := inprod(t1dot,w1dot, s, c) rx2dot := inprod(t2dot,w2dot, c,-s) ry2dot := inprod(t2dot,w2dot, s, c) // Convert to world (x,y) coordinates p1!2 := rx1dot + cgxdot p1!3 := ry1dot + cgydot // The bat cannot move vertically p2!2 := rx2dot + cgxdot p2!3 := ry2dot + cgydot // Apply a small repulsive force p1!0 := p1!0 - muldiv(0_05000, c, p1!1 := p1!1 - muldiv(0_05000, s, p2!0 := p2!0 + muldiv(0_05000, c, p2!1 := p2!1 + muldiv(0_05000, s, RETURN } }
One) One) One) One)
This function may look complicated but is, in fact, quite easy to understand. It take four argumnents. The rst, p1 is a pointer to the locations holding the (x,y) coordinates and velocity of the rst object involved in the collision, and p2 points to the coordinates and velocity of the second object. Pointers are used since cbounce may need to update both the position and velocity of each object after the collision. The masses of the two objects are given in arbitrary units in m1 and m2. If object 1 is a bucket corner it is given innite mass by setting m1=1 and m2=0. If the collision is between two balls, they are given equal mass by setting m1=1 and m2=1, and if object 1 is the bat and object 2 is a ball, m1 is set to 5 and m2 is set to 1, indicating that the mass of the bat is ve times that of a ball. The direction from the centre of object 1 to the centre of object 2 is calculated by a call of cosines whose arguments are the horizontal and vertical displacements between the two centres. On return, the result is the cosine of the direction relative to the x axis, and result2 holds the corresponding sine. The implementation of cosines is described later. When object 1 is a bucket corner, the calculation is simple since the corner is xed and the balls velocity in the direction of the to centres is reversed with some energy loss. This velocity is calculated using the direction cosines by the call inprod(xdot,ydot,c,s). The tranverse velocity (orthogonal to the line between the centres) is calculated by the call inprod(xdot,ydot,-s,c). The results are
148
placed in tdot and wdot, respectively. If the ball is approaching the corner tdot will be negative, a bounce will take place implemented by replacing tdot with the result of rebound(tdot). The inverse tranformation is performed to convert the velocities back to world (x,y) coordinates. The case when m1=m2 is two balls of equal mass collide and its implementation is a straightforward optimisation of the general case given at the end of cbounce that deals with objects with dierent masses. We will look at this general case rst. The principles underlying this kind of collision was all worked out by Isaac Newton and described in 1687 in Principia Mathematica. His second law states that the acceleration a of a body is parallel and directly proportional to the net force F acting on the body, is in the direction of the force and is inversely proportional to the mass m of the body, i.e. F=ma. Note that we are using the standard mathematical convention that quantities that have both magnitude and direction, such as F and a appear in bold while those such a m that only have magnitude are non bold. Suppose F and m are such as to cause an acceleration of one foot per second per second, then appying the force for one second would increase the speed of the body by one foot per second. Applying it for two seconds would increase the speed by two feet per second. Thus if t was the length of time the force was appied and v was the resulting change in velocity then Ft = mv. The term Ft is called the impulse, and mv is called the change in momentum. When two bodies collide they receive equal and opposite impulses so their changes in momentum are equal and opposite. The total momentum of two colliding bodies is thus unchanged by the collision. It is easy to see that the velocity of the combined centre of gravity of two objects in unaected by the collision. We calculate the velocity of the combined centre of gravity by declaring cgxdot to have value (p1!2*m1+p2!2*m2)/(m1+m2) and cgydot to have value (p1!3*m1+p2!3*m2)/(m1+m2). We then subtract this velocity from the velocities of the two objects, declaring rx1dot, ry1dot, rx2dot and ry2dot to be the velocities of the two object relative to the centre of gravity. Even though we are now in a moving frame of reference the behaviour of the objects are unchanged. After all, if you play billiards or snooker the behaviour of the balls is not aected by the fact we are travelling at a more or less uniform rate of 15 miles per second around the sun, and further more, if you play in the same billiard table six months later when we are on the other side of the sun, even though we are now traveling at 15 miles per second in the opposite direction. Viewing the situation relative to the centre of gravity is a great simplication, since the centre of gravity now appears to be stationary, and the two objects are moving toward the centre of gravity until they bounce, when the will then begin moving away. At the moment of collision the each receive impulses that are equal and opposite along the line joining their centres. If there is some loss of energy during the collision the component of velocity in the direction between the centre
149
will be reversed with its magnitude slightly reduced. We assume that the component orthogonal to this direction will be unchanged. If we call these two directions t and w, we can compute the velocity component of object 1 in direction t by evaluating inprod(rx1dot,ry1dot,c,s), calling the result t1dot. The component orthogonal to this in computed by inprod(rx1dot,ry1dot,-s,c) and given the name w1dot. The velocity components of the other object are computed similarly and given names t2dot and w2dot. At the moment of collision the components in direction t are reversed using calls of rebound which also simulates a slight loss in energy. The inverse transformation is then performed to obtain the velocities after the collision of the two objects relative the centre of gravity, and nally the velocities in real world coordinates are obtained by adding the velocity of the centre of gravity to each object. The results are the assigned to the velocity components pointed to by p1 and p2. To make the packing of the balls in the bucket realistic, a small repulsive force is applied to both objects when they are in contact. As stated earlier, the case when two balls collide (m1=m2) is an optimisation of this code taking advantage that the masses of the two balls are the same. Whenever a ball bounces it loses some energy and this loss is implemented by the function rebound, dened below.
AND rebound(vel) = vel/10 - vel // Returns the rebound speed of a bounce
It negates the given velocity and reduces its magnitude slightly by multiplying it by 90%. The implementation does this by subtracting 10% to avoid possible overow. When a ball collides with another ball, the bat or a round corner of the bucket, it is necessary to calculate the direction of the line joining the centres of the two objects. This direction could be represented by the angle between this line and the x-axis, but it is more convenient to represent it as the cosine and sine of this angle. These two values are often called direction cosines, and can be thought of as the coordinates of a point at the required angle on a unit circle. The function cosines computes them from given displacements dx and dy of the two centres in the x and y directions. This calculation could have been done by taking the inverse tangent of dy/dx and then computing the cosine and sine of the resulting angle, but for this program an alternative method is used. If you think of a right angled triangle whose two shorter sides are of length dx and dy lying parallel x and y -axes, by Pythagoras theorem the hypotenuse the 2 will be of length (dx + dy2 ), and so the required cosine and sine will be dx and (dxdy . The function cosines, dened below, rst reduces the 2 (dx2 +dy2 ) +dy2 ) size of the triangle by dividing dx and dy by the so called Manhatten distance ABS dx + ABS dy. This will cause the hypotenuse to have a length somewhere between about 0.7 and 1. The square of this length is placed in a and the approximate values of cosine and sine are held in c and s. To correct these values
150
they must be divided by the square root of a which is computed to sucient precision by just three interations of Newton-Raphson using a well chosen initial guess. The Newton-Raphson iteration is illustrated by the following diagram.
y y = f(x) = x^2 a P
2 The iteration is based on the function f (x) = x a which has the property that x = a when f (x) = 0. As shown in Section 5.6, the slope of f (x) is its dierential which, in this case, is 2x. To nd a value of d for which f (d) = 0 we can make a guess, say d = 1, corresponding to point A in the diagram, and improve it by reducing d by f (d) divided by the slope of f (x) at x = d. The new guess is then d(d2 a)/2d which simplies to (d+a/d)/2. This step is encoded by the statement d:=(d+muldiv(dsq,One,d))/2. The new value of d corresponds to point B in the diagram. If you uncomment the writef statements you will see how rapidly this process converges. In fact, each iteration approximately doubles the number of signicant digits, so if we started with a guess that was correct to one signicant place, the successive iterations would be correct to about 2, 4, 8 and 16 places. Indeed, if we did the calculation to sucient precision, 10 iterations would give us an answer correct to about 1000 places. However, for our purposes the 4 digits of precision obtained by three iterations is sucient. To understand this mechanism in more detail, do a web search on newton raphson. The denition of cosines is as follows.
AND cosines(dx, dy) = VALOF { LET d = ABS dx + ABS dy LET c = muldiv(dx, One, d) LET s = muldiv(dy, One, d)
// Approximate cos and sin // Direction good, length not.

LET a = muldiv(c,c,One)+muldiv(s,s,One) // 0.5 <= a <= 1.0 d := 1_00000 // With this initial guess only 3 iterations // of Newton-Raphson are required. //writef("a=%8.5d d=%8.5d d^2=%8.5d*n", a, d, muldiv(d,d,One)) d := (d + muldiv(dsq, One, d))/2 //writef("a=%8.5d d=%8.5d d^2=%8.5d*n", a, d, muldiv(d,d,One)) d := (d + muldiv(dsq, One, d))/2 //writef("a=%8.5d d=%8.5d d^2=%8.5d*n", a, d, muldiv(d,d,One)) d := (d + muldiv(dsq, One, d))/2 //writef("a=%8.5d d=%8.5d d^2=%8.5d*n", a, d, muldiv(d,d,One))
151
s := muldiv(s, One, d) // Corrected cos and sin c := muldiv(c, One, d) //writef("dx=%10.5d dy=%10.5d => cos=%8.5d sin=%8.5d*n", dx, dy, c, s) result2 := s RESULTIS c }
The cosine is returned as the result of cosines and the sine is returned in the global result2. If a point has coordinates (x, y ) then its component in the direction specied by cosines (c, s) is xc + ys. This value is sometimes called the inner product of the two pairs (x, y ) and (c, s). For our scaled numbers with 5 digits after the decimal point, this calculation and be performed by calling inprod(x,y,c,s). The denition of inprod is as follows.
AND inprod(dx, dy, c, s) = muldiv(dx, c, One) + muldiv(dy, s, One)
As the game proceeds, the window is repeatedly redrawn perhaps as often as 20 times per second to give the illusion that the bat and balls are moving smoothly. The function step is used to calculate the new the positions of the bat and balls for each image frame. This functions uses ballbounces to deal with bounces between balls and the bat or xed surfaces such as the walls or bucket. Most of ballbounces is easy to understand, but since it is rather long it will be described a few lines at a time. It starts as follows.
AND ballbounces(pv) BE { // This function deals with bounces between the ball whose position // and velocity is specified by pv and the bat or any fixed surface. // It does not deal with ball on ball bounces. LET cx, cy, vx, vy = pv!0, pv!1, pv!2, pv!3 TEST xlim_bucket_ll <= cx <= xlim_bucket_rr &
152
ylim_baseb <= cy <= ylim_topt THEN { // The ball cannot be in contact with the cieling, floor or // either wall so we only need to check for contact with // the bucket
The argument pv points to consecutive locations holding the (x,y) coordinates of a ball and its velocities in the x and y directions. These are extracted and placed in the variables cx, cy, vx and vy. The TEST command then determines whether the ball might bounce o the bucket or the walls. The THEN case deals with possible bounces o the bucket.
IF cy >= bucket_tyc DO { LET ecx, ecy, evx, evy = bucket_lxc, bucket_tyc, 0, 0 IF incontact(@ecx, pv, endradius+ballradius) DO { cbounce(@ecx, pv, 1, 0) // No other bounces possible RETURN } ecx := bucket_rxc IF incontact(@ecx, pv, endradius+ballradius) DO { cbounce(@ecx, pv, 1, 0) // No other bounces possible RETURN } // No other bounces possible RETURN }
If cy is greater bucket tyc, the only possible bounces are with the two rounded tops of each side of the bucket. These are tested for and dealt with using appropriate calls of incontact and cbounce.
IF cy >= bucket_byc DO { // Possibly bouncing with bucket walls IF cx <= bucket_lxc DO { // Bounce with outside of bucket left wall pv!0 := xlim_bucket_ll IF vx>0 DO pv!2 := rebound(vx) } IF bucket_lxc < cx <= xlim_bucket_lr DO { // Bounce with inside of bucket left wall pv!0 := xlim_bucket_lr IF vx<0 DO pv!2 := rebound(vx)

} IF xlim_bucket_rl <= cx < bucket_rxc DO { // Bounce with inside of bucket right wall pv!0 := xlim_bucket_rl IF vx>0 DO pv!2 := rebound(vx) } IF bucket_rxc < cx DO { // Bounce with outside of bucket right wall pv!0 := xlim_bucket_rr IF vx<0 DO pv!2 := rebound(vx) } }
153
If bucket byc<=cy<=bucket tyc, the only possible bounces are with the inside or outside of the bucket walls. These four possibilities are straightforward and dealt with in turn.
// Bounce with base UNLESS starting DO { // The bucket base is present IF bucket_lxc <= cx <= bucket_rxc DO { IF cy < bucket_byc DO { // Bounce on the outside of the base pv!1 := ylim_baseb IF vy>0 DO pv!3 := rebound(vy) // No other bounces are possible RETURN } IF bucket_byc <= cy <= ylim_baset DO { // Bounce on the top of the base pv!1 := ylim_baset IF vy<0 DO pv!3 := rebound(vy) // No other bounces are possible RETURN } } }
If starting is FALSE the base of the bucket is present, and so bouncing is possible of its top or bottom surfaces. The above code deals with two cases. If either bounce occurs no other bounces are possible, so the function returns.
154

// Bounces with the bottom corners IF cy < bucket_byc DO { LET ecx, ecy, evx, evy = bucket_lxc, bucket_byc, 0, 0 IF incontact(@ecx, pv, endradius+ballradius) DO { // Bounce with bottom left corner cbounce(@ecx, pv, 1, 0) // No other bounces are possible RETURN } ecx := bucket_rxc IF incontact(@ecx, pv, endradius+ballradius) DO { // Bounce with bottom right corner cbounce(@ecx, pv, 1, 0) // No other bounces are possible RETURN } } }
The above code deals with bounces o the bottom two corners of the bucket, but is only reached if the ball did not bounce o the bucket base, if present. As before, these corner bounces are easy to implement using suitable calls of incontact and cbounce. The rest of ballbounces deals with bounces known not to be o the bucket, and since ball on ball bounces are not performed by ballbounces the only possiblities are with the bat, wall, ceiling or oor. The following code deals with them all.
ELSE { // The ball can only be in contact with the bat, side walls, // ceiling or floor // Bouncing with the bat IF incontact(@batx, pv, batradius+ballradius) DO { pv!4, pv!5 := 0, 0 cbounce(@batx, pv, 5, 1) batydot := 0 // Immediately damp out the bats vertical motion } // Left wall bouncing IF cx <= xlim_lwall DO { pv!0 := xlim_lwall IF vx<0 DO pv!2 := rebound(vx) }

// Right wall bouncing IF cx >= xlim_rwall DO { pv!0 := xlim_rwall IF vx>0 DO pv!2 := rebound(vx) } // Ceiling bouncing IF cy >= ylim_ceiling DO { pv!1 := ylim_ceiling IF vy>0 DO pv!3 := rebound(vy) // No other bounces are possible RETURN } // Floor bouncing IF cy <= ylim_floor DO { pv!1 := ylim_floor IF vy<0 DO pv!3 := rebound(vy) } // No other bounces are possible RETURN } }
155
Notice that the above code allowed for bounces to occur simultaneously between the ball and, say, a wall and the oor. The function step is called repeatedly to update the positions of the balls and the bat. It denition starts as follows.
LET step() BE { IF started UNLESS finished DO displaytime := sdlmsecs() - starttime
The timer starts as soon as the bucket base is reinstated after all three balls have fallen out of the bucket. It continues measuring the time until the three balls have again settled into the bucket. The variable displaytime holds the time measured in milli-seconds since the start. It is only updated after started becomes TRUE and before finished becomes TRUE. The next fragment of code updates started to TRUE at the appropriate moment.
// Check whether to close the base
156
WHILE starting DO { IF ylim_baseb < cgy1 & bucket_lxc < cgx1 < bucket_rxc BREAK IF ylim_baseb < cgy2 & bucket_lxc < cgx2 < bucket_rxc BREAK IF ylim_baseb < cgy3 & bucket_lxc < cgx3 < bucket_rxc BREAK starting := FALSE started := TRUE finished := FALSE starttime := sdlmsecs() displaytime := 0 BREAK }
This code is not really a WHILE loop since its body is not repeatedly executed. It is a trick to allow the use of BREAK to exit from this fragment of code. The rst IF statement executes BREAK if the rst ball is above or would be in contact with the bucket base and has an x value between the walls of the bucket. The second and third IF statements perform the same test for the other two balls. If none of these tests call BREAK, the game has just started causing starting to be set to FALSE and started to TRUE. The other three variables finished, starttime and displaytime are also initialised appropriately. The next fragment tests whether the balls have returned to the bucket.
IF started UNLESS finished DO IF bucket_byt < cgy1 < bucket_tyb & bucket_lxc < cgx1 < bucket_rxc & bucket_byt < cgy2 < bucket_tyb & bucket_lxc < cgx2 < bucket_rxc & bucket_byt < cgy3 < bucket_tyb & bucket_lxc < cgx3 < bucket_rxc & ABS cgy1dot < 2_00000 & ABS cgy2dot < 2_00000 & ABS cgy3dot < 2_00000 DO finished := TRUE
It checks that the centre of each ball is within the bucket and that none of them are travelling fast enough in the y direction to escape. If all these tests succeed, finished is set to TRUE. Variables, such ax1 and ay1, hold the horizontal and vertical accelerations of the balls. They are initialised by the following code.
// Calculate the accelerations of the balls // Initialise as apply gravity ax1, ay1 := 0, -ag ax2, ay2 := 0, -ag

ax3, ay3 := 0, -ag // Add ax1 := ax2 := ax3 := a little random horizontal motion ax1 + randno(2001) - 1001 ax2 + randno(2001) - 1001 ax3 + randno(2001) - 1001
157
They are each given a vertical acceleration of -ag simulating gravity and small random horizontal accelerations to stop balls being able to stand unrealistically in a vertical column. The next fragments are concerned with the bouncing of the balls on any surface they come in contact with. The following code deals with the balls bouncing of the left and right hand walls.
ballbounces(@cgx1) ballbounces(@cgx2) ballbounces(@cgx3)
The ball on ball bounces are dealt with by the follow code. The only subtlety is that during a bounce the force of gravity are ignored by setting, for instance, ay1 and ay2 to zero. Since all ball have the same mass m1 and m2 are both given value 1.
// Ball on ball bounce IF incontact(@cgx1, @cgx2, ballradius+ballradius) DO { ay1, ay2 := 0, 0 cbounce(@cgx1, @cgx2, 1, 1) } IF incontact(@cgx1, @cgx3, ballradius+ballradius) DO { ay1, ay3 := 0, 0 cbounce(@cgx1, @cgx3, 1, 1) } IF incontact(@cgx2, @cgx3, ballradius+ballradius) DO { ay2, ay3 := 0, 0 cbounce(@cgx2, @cgx3, 1, 1) }
Then follows code to updates the velocities of the three balls and their positions.
158

the balls + ax1/Sps + ay1/Sps + ax2/Sps + ay2/Sps + ax3/Sps + ay3/Sps
// Apply forces to cgx1dot := cgx1dot cgy1dot := cgy1dot cgx2dot := cgx2dot cgy2dot := cgy2dot cgx3dot := cgx3dot cgy3dot := cgy3dot
cgx1, cgy1 := cgx1 + cgx1dot/Sps, cgy1 + cgy1dot/Sps cgx2, cgy2 := cgx2 + cgx2dot/Sps, cgy2 + cgy2dot/Sps cgx3, cgy3 := cgx3 + cgx3dot/Sps, cgy3 + cgy3dot/Sps
If B is pressed the bat moves randomly. This is implemented by setting randombat to TRUE, and then selecting a new target x position for the bat every half second. The bat always accelerates to this target. The selected target is either the position of the nearest ball below the bucket, or any random position between the to walls. The speed of the bat is limited to no more than 400 pixels per second. If the bat hits a wall it bounces without loss of energy. The y position of the bat is also given a slight correction.
IF randombat DO { LET t = sdlmsecs() IF t > randbattime + 0_500 DO { // Choose a new random target x position every 1/2 second randbatx := randno(screenxsize*One) IF (randbatx & #b10000)=0 DO { // About 50% of the time choose as target the x position // of the closest ball that is below the bucket IF cgy1<bucket_byb DO randbatx := cgx1 IF cgy2<bucket_byb & ABS(batx-cgx2)<ABS(randbatx-batx) DO randbatx := cgx2 IF cgy3<bucket_byb & ABS(batx-cgx3)<ABS(randbatx-batx) DO randbatx := cgx3 } randbattime := t } TEST batx > randbatx THEN abatx := -1500_00000 ELSE abatx := 1500_00000 } // Apply forces to the bat batxdot := batxdot + abatx/sps IF batxdot> 400_00000 DO batxdot := 400_00000 IF batxdot<-400_00000 DO batxdot := -400_00000

batx := batx + batxdot/sps IF batx+batradius > wall_rx DO { batx := wall_rx - batradius batxdot := -batxdot } IF batx-batradius < 0 DO { batx := batradius batxdot := -batxdot } // Slowly correct baty baty := baty - (baty - batradius)/10 }
159
In the rst iteration of this program the bucket with or without its base, the balls and the bat were all drawn from scratch each time a new frame was displayed. This turned out to be too inecient for the Raspberry Pi and so a more ecient implementation was chosen. This involved creating small SDL surfaces containing fragments of the scene which could be copied to the screen eciently when needed. The fragments chosen were a wall of the bucket with its rounded ends, the three coloured balls and the bat. The corresponding surfaces are held in bucketwallsurf, bucketbasesurf, ball1surf, ball2surf, ball3surf and batsurf. They are created when needed by functions such as initbucketwallsurf dened below.
AND initbucketwallsurf() = VALOF { // Allocate a surface for the bucket walls LET width = 2*endradius/One + 1 LET height = (bucket_tyt - bucket_byb)/One + 2 LET surf = mksurface(width, height) selectsurface(surf, width, height) fillsurf(backcolour) // Draw the ends TEST debugging THEN setcolour(bucketendcolour) ELSE setcolour(bucketcolour) drawfillcircle(endradius/One, endradius/One, endradius/One-1) drawfillcircle(endradius/One, height-endradius/One, endradius/One-1) // Draw the wall setcolour(bucketcolour)
160
drawfillrect(0, endradius/One, width, height-endradius/One) RESULTIS surf }
It rst calculates the width and height of the fragment, and creates a surface of the size. It lls the surface with the backgraound colour and then draws the rounded ends of the bucket wall by suitable calls of drawfillcircle. The wall itself is then drawn by a call of drawfillrect. Notice that when debugging is TRUE the circular bucket ends are given a dierent colour. The coding of the other initialisation functions follow the same pattern. They are dened as follows.
AND initbucketbasesurf(col) = VALOF { // Allocate the bucket base surface LET height = 2*endradius/One + 1 LET width = (bucket_rxc - bucket_lxc)/One + 1 LET surf = mksurface(width, height) selectsurface(surf, width, height) fillsurf(backcolour) setcolour(bucketcolour) drawfillrect(0, 0, width, height) RESULTIS surf } AND initballsurf(col) = VALOF { // Allocate a ball surface LET height = 2*ballradius/One + 2 LET width = height LET colkey = maprgb(64,64,64) LET surf = mksurface(width, height) selectsurface(surf, width, height) fillsurf(colkey) setcolourkey(surf, colkey) setcolour(col) drawfillcircle(ballradius/One, ballradius/One+1, ballradius/One) RESULTIS surf } AND initbatsurf(col) = VALOF { // Allocate a bat surface LET height = 2*batradius/One + 2

LET width = height LET surf = mksurface(width, height) selectsurface(surf, width, height) fillsurf(backcolour) setcolour(batcolour) drawfillcircle(batradius/One, batradius/One+1, batradius/One) RESULTIS surf }
161
The only subtlety is in the function initballsurf which uses a feature called colour keying to cause only the circular ball to be written to the screen. The pixels outside the circle are given a special colour held in colkey and the call setcolourkey(surf,colkey) tells the surface not to copy any pixels of this colour to the screen. If you comment out the call of setcolourkey you will see why this call is necessary. The next function plotscreen draws the entire scene. It rst lls in the background colour and then checks all the required surface fragments have been created. It then copies the to the screen by calls of blitsurf. This function takes four arguments src, dst, x and y, where src and dst are the source and destination surfaces, and (x,y) is the position in the destination of where the top leftmost pixel of the source should be placed. The denition of plotscreen starts as follows.
AND plotscreen() BE { selectsurface(screen, screenxsize, screenysize) fillsurf(backcolour) // Allocate the surfaces UNLESS bucketwallsurf DO UNLESS starting | bucketbasesurf DO UNLESS ball1surf DO UNLESS ball2surf DO UNLESS ball3surf DO UNLESS batsurf DO if necessary bucketwallsurf := initbucketwallsurf() bucketbasesurf ball1surf ball2surf ball3surf batsurf := := := := := initbucketbasesurf() initballsurf(ball1colour) initballsurf(ball2colour) initballsurf(ball3colour) initbatsurf(batcolour)
// Left bucket wall blitsurf(bucketwallsurf, screen, bucket_lxl/One, bucket_tyt/One) // Right bucket wall blitsurf(bucketwallsurf, screen, bucket_rxl/One, bucket_tyt/One) IF bucketbasesurf DO
162

blitsurf(bucketbasesurf, screen, bucket_lxc/One, bucket_byt/One-1)
// The bat blitsurf(batsurf, screen, (batx-batradius)/One, (baty+batradius)/One) // Finally, the three balls blitsurf(ball1surf, screen, (cgx1-ballradius)/One, (cgy1+ballradius)/One) blitsurf(ball2surf, screen, (cgx2-ballradius)/One, (cgy2+ballradius)/One) blitsurf(ball3surf, screen, (cgx3-ballradius)/One, (cgy3+ballradius)/One)
This draws the bucket with or without its bas the three coloured balls and the bat. All that remains is to write some text on the screen. This is done by the following code.
setcolour(maprgb(255,255,255)) IF finished DO plotf(30, 300, "Finished -- Well Done!") IF started | finished DO plotf(30, 280, "Time %9.2d", displaytime/10) IF help DO { plotf(30, plotf(30, plotf(30, plotf(30, plotf(30, plotf(30, plotf(30, plotf(30, }
150, 135, 120, 105, 90, 75, 60, 45,
"R -- Reset") "S -- Start the game") "P -- Pause/Continue") "H -- Toggle help information") "B -- Toggle bat random motion") "D -- Toggle debugging") "U -- Toggle usage") "Left/Right arrow -- Control the bat")
IF displayusage DO plotf(30, 245, "CPU usage = %i3%% sps = %n", usage, sps) IF debugging DO { plotf(30, 220, "Ball1 x=%10.5d y=%10.5d cgx1, cgy1, cgx1dot, cgy1dot) plotf(30, 205, "Ball2 x=%10.5d y=%10.5d cgx2, cgy2, cgx2dot, cgy2dot) plotf(30, 190, "Ball3 x=%10.5d y=%10.5d cgx3, cgy3, cgx3dot, cgy3dot) plotf(30, 175, "Bat x=%10.5d y=%10.5d batx, baty, batxdot)
xdot=%10.5d xdot=%10.5d xdot=%10.5d xdot=%10.5d",
ydot=%10.5d", ydot=%10.5d", ydot=%10.5d",

} }
163
This code uses plotf to write text to specied positions on the screen but otherwise should be self explanatory. The next function initialises the position and velocity of the balls and a few other variables. It denition is as follows.
AND resetballs() BE { cgy1 := bucket_byt+ballradius + 10_00000 cgy2 := bucket_byt+3*ballradius + 20_00000 cgy3 := bucket_byt+5*ballradius + 30_00000 cgx1, cgx2, cgx3 := screen_xc, screen_xc, screen_xc cgx1dot, cgx2dot, cgx3dot := 0, 0, 0 cgy1dot, cgy2dot, cgy3dot := 0, 0, 0 starting started finished displaytime } := := := := FALSE FALSE FALSE -1
The function processevents deals with input from the mouse and keyboard. Most keyboard events are simple letters detected when the key is pressed. These are all easily understood. The only subtlety is the treatment of the left and right arrow keys. An acceleration of 750 00000 is added to abatx while the right arrow key is held down. When it is eventually raised 750 00000 is decremented from abatx. Thus while the right arrow key is pressed the bat accellerates at a constant rate to the right. Similarly, the left arrow key accelerates the bat to the left.
AND processevents() BE WHILE getevent() SWITCHON eventtype INTO { DEFAULT: LOOP CASE sdle_keydown: SWITCHON capitalch(eventa2) INTO { DEFAULT: LOOP CASE Q: done := TRUE LOOP CASE ?:
164

CASE H: help := ~help LOOP CASE D: debugging := ~debugging IF bucketwallsurf DO { freesurface(bucketwallsurf) bucketwallsurf := 0 } LOOP CASE U: displayusage := ~displayusage LOOP CASE B: randombat := ~randombat abatx := 0 randbatx := screen_xc randbattime := 0 LOOP CASE S: // Start again UNLESS ylim_baseb < cgy1 & bucket_lxc < cgx1 < bucket_rxc & ylim_baseb < cgy2 & bucket_lxc < cgx2 < bucket_rxc & ylim_baseb < cgy3 & bucket_lxc < cgx3 < bucket_rxc DO resetballs() starting := TRUE started := FALSE finished := FALSE starttime := -1 displaytime := -1 IF bucketbasesurf DO { freesurface(bucketbasesurf) bucketbasesurf := 0 } LOOP CASE P: // Toggle stepping stepping := ~stepping LOOP CASE R: // Reset the balls resetballs() finished := FALSE starting := FALSE displaytime := -1 LOOP
165
CASE sdle_arrowright: abatx := abatx + 750_00000; LOOP CASE sdle_arrowleft: abatx := abatx - 750_00000; LOOP } CASE sdle_keyup: SWITCHON capitalch(eventa2) INTO { DEFAULT: LOOP CASE sdle_arrowright: abatx := abatx - 750_00000; LOOP CASE sdle_arrowleft: abatx := abatx + 750_00000; LOOP }
CASE sdle_quit: writef("QUIT*n"); done := TRUE LOOP }
Notice that the surface fragment bucketballsurf must be cleared when D is pressed since toggling the debugging ag causes the colour of the bucket ends to change. Similarly, bucketbasesurf must be cleared when S is pressed. The nal function start is the main program. It initialises all the required variables and then enters the event loop to repeatedly read events, update the stated of the balls and bat and display the result. If you comment out the IF FALSE DO line near the top, code will run to test the cosines function. This was a debugging aid used to ensure the cosines behaved correctly.
LET start() = VALOF { LET stepmsecs = ? LET comptime = 0 // Amount of cpu time per frame bucketwallsurf := 0 bucketbasesurf := 0 ball1surf := 0 ball2surf := 0 ball3surf := 0 batsurf := 0
166
IF FALSE DO { // Code to test the cosines function LET e1, e2 = One, One FOR dy = 0 TO One BY One/100 DO { LET c, s, rsq = ?, ?, ? c := cosines(One, dy) s := result2 rsq := muldiv(c,c,One) + muldiv(s,s,One) writef("dx=%9.5d dy=%9.5d cos=%9.5d sin=%9.5d rsq=%9.5d*n", One, dy, c, s, rsq) IF e1 < rsq DO e1 := rsq IF e2 > rsq DO e2 := rsq } writef("Errors +%6.5d -%7.5d*n", e1-One, One-e2) RESULTIS 0 } initsdl() mkscreen("Ball and Bucket", 800, 500) help := TRUE randombat := FALSE randbatx := screen_xc randbattime := 0 stepping := TRUE // =FALSE if not stepping starting := TRUE // Trap door open started := FALSE finished := FALSE starttime := -1 displaytime := -1 usage := 0 debugging := FALSE displayusage := FALSE sps := 40 // Initial setting stepmsecs := 1000/sps backcolour bucketcolour bucketendcolour ball1colour ball2colour ball3colour batcolour := := := := := := := maprgb(120,120,120) maprgb(170, 60, 30) maprgb(140, 30, 30) maprgb(255, 0, 0) maprgb( 0,255, 0) maprgb( 0, 0, 255) maprgb( 40, 40, 40)
167
wall_lx := 0 wall_rx := (screenxsize-1)*One floor_yt := 0 ceiling_yb := (screenysize-1)*One
// Right wall // Floor // Ceiling
screen_xc := screenxsize*One/2 bucket_tyt := ceiling_yb - 4*ballradius bucket_tyc := bucket_tyt - endradius bucket_tyb := bucket_tyt - bucketthickness bucket_lxr := screen_xc - ballradius * 3 / 2 bucket_lxc := bucket_lxr - endradius bucket_lxl := bucket_lxr - bucketthickness bucket_rxl := screen_xc + ballradius * 3 / 2 bucket_rxc := bucket_rxl + endradius bucket_rxr := bucket_rxl + bucketthickness bucket_byt := bucket_tyt - 8*ballradius bucket_byc := bucket_byt - endradius bucket_byb := bucket_byt - bucketthickness xlim_lwall xlim_rwall ylim_floor ylim_ceiling xlim_bucket_ll xlim_bucket_lc xlim_bucket_lr xlim_bucket_rl xlim_bucket_rc xlim_bucket_rr ylim_topt ylim_baseb ylim_baset resetballs() ax1, ay1 := 0, 0 ax2, ay2 := 0, 0 ax3, ay3 := 0, 0 batx := screen_xc // Acceleration of ball 1 // Acceleration of ball 2 // Acceleration of ball 3 // Position of bat := := := := := := := := := := := := := wall_lx wall_rx floor_yt ceiling_yb bucket_lxl bucket_lxc bucket_lxr bucket_rxl bucket_rxc bucket_rxr bucket_tyt bucket_byb bucket_byt + + + + + + ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius ballradius
168
baty := floor_yt + batradius // Position of bat ylim_bat := floor_yt + batradius + ballradius batxdot, batydot := 150_00000, 0 // Velocity of bat abatx := 0 // Acceleration of bat done := FALSE UNTIL done DO { LET t0 = sdlmsecs() LET t1 = ? processevents() IF stepping DO step() usage := 100*comptime/stepmsecs plotscreen() updatescreen() UNLESS 60<usage<80 DO { TEST usage>70 THEN sps := sps-1 ELSE sps := sps+1 stepmsecs := 1000/sps } t1 := sdlmsecs() comptime := t1 - t0 IF t0+stepmsecs > t1 DO sdldelay(t0+stepmsecs-t1) } writef("*nQuitting*n") sdldelay(1_000) IF IF IF IF IF IF bucketwallsurf bucketbasesurf ball1surf ball2surf ball3surf batsurf DO DO DO DO DO DO freesurface(bucketwallsurf) freesurface(bucketbasesurf) freesurface(ball1surf) freesurface(ball2surf) freesurface(ball3surf) freesurface(batsurf)
closesdl() RESULTIS 0 }
5.10. MOON LANDER
169
5.10
/*
Moon Lander
This is a re-inplementation of a moon lander program originally written in September 1973 for the PDP-7 and the Vector General display. It now uses the SDL graphics library and runs under Linux, the Raspberry Pi and Windows.
(c) Martin Richards */ GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
January 2013
MANIFEST { fuelmax=4000000 } STATIC { shape=9111 rotforce=0//50 ///* Perfect landing cgx= 322_855_260 // in millimetres cgy= 129_712_464 -16000 +3000 theta= 3232 cgxdot=-526_837 // in millimetres per second cgydot= -0_357 thetadot= 32 //*/
/* Take off cgx=-37000000 cgy=28001 theta=64*1000 cgxdot=0 cgydot=1 thetadot=-32
170
*/
minscale = 400 fuel=fuelmax thrust=450 dthrust=50 target=-37000000 halftargetsize=30_000 // in millimetres scale=4 weight=300 mass=1 moonradius = 8000*#x1000 * 7 / 22 // circumference/pi costheta=0 sintheta=0 flamelength=0 x0=0 y0=0 thrustmax=2000 thrustmin=100 single=FALSE novice=FALSE delay=1 offscreen=TRUE ch=0 tracing=FALSE } GLOBAL { done:ug rotleft rotright landed // Quality of the landing toofast // Quality of the landing badsite badorientation goodlanding stepping col_black col_blue col_green col_yellow col_red
5.10. MOON LANDER

col_majenta col_cyan col_white col_darkgray col_darkblue col_darkgreen col_darkyellow col_darkred col_darkmajenta col_darkcyan col_gray col_lightgray col_lightblue col_lightgreen col_lightyellow col_lightred col_lightmajenta col_lightcyan } LET start() = VALOF { LET mes = VEC 256/bytesperword writes("*nMoon Lander*n") initsdl() mkscreen("Moon Lander", 640, 480) rotleft, rotright := FALSE, TRUE startlander(format) //Update screen updatescreen() //Pause for 10 secs sdldelay(10_000); //Quit SDL closesdl() writef("Done!*n") RESULTIS 0
171
172
}
AND startlander(fmt) = VALOF { LET count = 0 // Declare a few colours in the pixel format of the screen col_black := maprgb( 0, 0, 0) col_blue := maprgb( 0, 0, 255) col_green := maprgb( 0, 255, 0) col_yellow := maprgb( 0, 255, 255) col_red := maprgb(255, 0, 0) col_majenta := maprgb(255, 0, 255) col_cyan := maprgb(255, 255, 0) col_white := maprgb(255, 255, 255) col_darkgray := maprgb( 64, 64, 64) col_darkblue := maprgb( 0, 0, 64) col_darkgreen := maprgb( 0, 64, 0) col_darkyellow := maprgb( 0, 64, 64) col_darkred := maprgb( 64, 0, 0) col_darkmajenta := maprgb( 64, 0, 64) col_darkcyan := maprgb( 64, 64, 0) col_gray := maprgb(128, 128, 128) col_lightblue := maprgb(128, 128, 255) col_lightgreen := maprgb(128, 255, 128) col_lightyellow := maprgb(128, 255, 255) col_lightred := maprgb(255, 128, 128) col_lightmajenta:= maprgb(255, 128, 255) col_lightcyan := maprgb(255, 255, 128) fillscreen(col_gray) IF FALSE DO { LET days, msecs, flag = ?, ?, ? datstamp(@days) // Draw some random coloured lines rapidly setcolour(col_blue) drawpoint(screenxsize/2, screenysize/2) FOR i = 1 TO 100_000 DO { LET col = maprgb(randno(255),randno(255),randno(255)) LET x, y = randno(screenxsize)-1, randno(screenysize)-1 IF i=10 DO setcaption("Hello World Again") setcolour(col) drawto(x, y) updatescreen()
5.10. MOON LANDER

//sdldelay(100) IF i MOD 100 = 99 DO { LET d, m, f = ?, ?, ? datstamp(@d) writef("%8.3d frames per second*n", 100000_000/(m-msecs)) days, msecs, flag := d, m, f } } RESULTIS 0 } lander() RESULTIS 0 } AND lander() BE { single := TRUE delay := 0 landed := FALSE stepping := TRUE done := FALSE UNTIL done DO { readcontrols() IF stepping DO step() sdldelay(100) } WHILE sys(Sys_pollsardch)=pollingch LOOP writes("*nPress any key*n") sys(Sys_sardch) newline() } AND setwindow() BE { // Set the position and scale of the window to display // ie set x0, y0 and scale. LET x, y = x0, y0 LET h = height(cgx) LET relheight = ABS(cgy-h)
173
// Choose scale so that relheight appears no larger that half screenysize LET s = relheight*2/screenysize scale := minscale UNTIL scale > s DO scale := scale*2
174
// Adjust y so that the moons surface is suitably places UNLESS screenysize*2/10 < (h-y)/scale < screenysize*4/10 DO y := h - (screenysize*3/10)*scale UNLESS screenysize/ 8 < (h-y0)/scale < screenysize/3 & screenysize/10 < (cgy-y0)/scale < screenysize*9/10 DO y0 := y IF screenxsize/4 > (cgx-x0)/scale DO x0 := cgx - (screenxsize*3/5)*scale IF screenxsize*3/4 < (cgx-x0)/scale DO x0 := cgx - (screenxsize*2/5)*scale IF tracing DO { writef("cgx=%n cgy=%n h=%n scale=%n x=%n y=%n*n", cgx, cgy, h, scale, (cgx-x0)/scale, (cgy-y0)/scale) writef("screenxsize=%n screenysize=%n*n", screenxsize, screenysize) } } AND readcontrols() BE { WHILE getevent(@eventtype) SWITCHON eventtype INTO { DEFAULT: writef("Unknown event type = %n*n", eventtype) LOOP CASE sdle_active: // => 1 //writef("active %d %d*n", eventa1, eventa2) LOOP CASE sdle_keydown: // => 2 mod ch SWITCHON capitalch(eventa2) INTO { DEFAULT: LOOP CASE .: rotforce := rotforce - 1 IF rotforce<-1 DO rotforce := -1 LOOP CASE ,: rotforce := rotforce + 1 IF rotforce>1 DO rotforce := 1 LOOP CASE Z: thrust := thrust - dthrust; LOOP CASE X: thrust := thrust + dthrust; LOOP CASE T: tracing := ~tracing; LOOP CASE P: stepping := ~stepping LOOP CASE Q: done := TRUE; LOOP } LOOP
5.10. MOON LANDER

CASE sdle_keyup: // => 3 mod ch //writef("keyup %d %d*n", eventa1, eventa2) LOOP CASE sdle_mousemotion: // 4 //writef("mousemotion %n %n %n*n", eventa1, eventa2, eventa3) LOOP CASE sdle_mousebuttondown: // 5 //writef("mousebuttondown*n", eventa1, eventa2, eventa3) LOOP CASE sdle_mousebuttonup: // 6 //writef("mousebuttonup*n", eventa1, eventa2, eventa3) LOOP
175
CASE sdle_joyaxismotion: // 7 { LET which = eventa1 LET axis = eventa2 LET value = eventa3 //writef("joyaxismotion %n %n %n*n", eventa1, eventa2, eventa3) SWITCHON axis INTO { DEFAULT: LOOP CASE 0: // rotforce IF value IF value LOOP Aileron := 0 > 0 DO rotforce := -1 < 0 DO rotforce := +1
CASE 1: // Elevator LOOP CASE 2: // Throttle thrust := thrustmax - muldiv(thrustmax-thrustmin, value+32769, 32768+32767) LOOP } } CASE sdle_joyballmotion: // 8 //writef("joyballmotion*n", eventa1, eventa2, eventa3) LOOP
176

CASE sdle_joyhatmotion: // 9 //writef("joyhatmotion*n", eventa1, eventa2, eventa3) LOOP CASE sdle_joybuttondown: // 10 //writef("joybuttondown*n", eventa1, eventa2, eventa3) LOOP CASE sdle_joybuttonup: // 11 //writef("joybuttonup*n", eventa1, eventa2, eventa3) LOOP CASE sdle_quit: writef("QUIT*n"); LOOP // 12
CASE sdle_syswmevent: // 13 //writef("syswmevent*n", eventa1, eventa2, eventa3) LOOP CASE sdle_videoresize: // 14 //writef("videoresize*n", eventa1, eventa2, eventa3) LOOP CASE sdle_userevent: // 15 //writef("userevent*n", eventa1, eventa2, eventa3) LOOP } } AND step() BE { thetadot := thetadot + 20*rotforce theta := theta + thetadot IF novice DO theta, thetadot := theta+15*thetadot, 0 costheta := cosine(theta) sintheta := sine(theta) // scaled d.ddd
IF thrust > thrustmax DO thrust := thrustmax IF thrust < thrustmin DO thrust := thrustmin IF fuel>0 DO { fuel := fuel - thrust IF fuel<0 DO fuel := 0 } IF fuel<=0 DO thrust := 0
5.10. MOON LANDER
177
flamelength := thrust*30000/thrustmax cgxdot := cgxdot + (thrust*costheta/1000 )/mass cgydot := cgydot + (thrust*sintheta/1000 - weight)/mass // Add the effect of centrifugal force. // This should allow the lander to remain in orbit, if cgxdot large enough. ///cgydot := cgydot + muldiv(cgxdot, cgxdot, cgy+moonradius) cgx := cgx + cgxdot cgy := cgy + cgydot //writef("x=%n, y=%n*n", cgx, cgy) IF tracing DO { writef("*nxydot= %n, %n*n", cgxdot, cgydot) writef("t,tdot = %n, %n*n", theta, thetadot) writef("x=%n, y=%n*n", cgx, cgy) writef("h = %n*n", height(cgx)) // writef("x0y0= %n, %n*n", x0, y0) // writef("scale = %n*n", scale) } // The CG of the lander is 3 metre above the feet. IF cgy <= height(cgx)+3_000 DO { toofast := FALSE badsite := FALSE badorientation := FALSE goodlanding := TRUE landed, thrust := TRUE, 0 stepping := FALSE writes("*nLanded*n") writef("xdot = %7.3d ydot = %7.3d*n", cgxdot, cgydot) UNLESS 0 < cgxdot*cgxdot+cgydot*cgydot < 1_500*1_500 DO { goodlanding := FALSE // Speed greater than 1.5 metre per second toofast := TRUE writef("Too fast*n") } // The craft width is 12 metres UNLESS ABS(height(cgx-6_000) - height(cgx)) + ABS(height(cgx+6_000) - height(cgx)) < 1000 DO { // Not level enough goodlanding := FALSE badsite := TRUE writef("Bad landing site*n") } UNLESS sintheta>950 DO
178

{ // Bad orientation goodlanding := FALSE badorientation := TRUE writes("Bad orientation*n") } IF goodlanding DO writes("Perfect, Well done!!*n")
} displayall() } AND height(x) = VALOF { IF -halftargetsize < x-target < halftargetsize DO x := target x := x/8000 { LET ra, rb, rc = x&#777, x&#77, x&#7 LET a, b, c = x-ra, x-rb, x-rc LET h = (hf(a)*(#777-ra) + hf(a+#1000)*ra + hf(b)*(#77 -rb) + hf(b+#100) *rb + hf(c)*(#7 -rc) + hf(c+#10) *rc)/512 h := h*h/100 IF (hf(x&-2)&#71)=0 DO h := h+4 RESULTIS h*6*1000 } } AND hf(n) = VALOF { LET a = n XOR shape LET b = a*(a XOR #4132)/100 + a RESULTIS (b*b/313*a) & 255 } AND cdrawto(x, y) BE { LET tx = x / minscale AND ty = y / minscale //writef("cdrawto: %n,%n ", x, y) x := (+tx*sintheta + ty*costheta)/1000 + (cgx-x0)/scale y := (-tx*costheta + ty*sintheta)/1000 + (cgy-y0)/scale //writef(" %n,%n*n", x, y) drawto(x, y) } AND cpoint(x, y) BE { LET tx = x / minscale
5.10. MOON LANDER

AND ty = y / minscale x := (+tx*sintheta + ty*costheta)/1000 + (cgx-x0)/scale y := (-tx*costheta + ty*sintheta)/1000 + (cgy-y0)/scale drawpoint(x, y) } AND plotcraft() BE { setcolour(col_white) // The units are millimetres // The craft width is 12 metres (-6 to +6) cpoint( -3000, -2000) // The base cdrawto ( 3000, -2000) cdrawto ( 3000, 0) cdrawto ( -3000, 0) cdrawto ( -3000, -2000) cpoint( cdrawto cdrawto cdrawto cdrawto cdrawto cdrawto cdrawto cpoint( cdrawto cpoint( cdrawto cpoint( cdrawto cpoint( cdrawto 1000, ( 2000, ( 2000, ( 1000, ( -1000, ( -2000, ( -2000, ( -1000, 0) // The return module 1000) 3000) 4000) 4000) 3000) 1000) 0)
179
-3000, -1000) // Lhe legs ( -5000, -3000) -6000, -3000) ( -4000, -3000) 3000, -1000) ( 5000, -3000) 4000, -3000) ( 6000, -3000)
setcolour(col_cyan) IF thrust DO { cpoint( 0, -3000) // The flame cdrawto ( -2000, -flamelength-3000) cdrawto ( 0, -flamelength/2-3000) cdrawto ( 2000, -flamelength-3000) cdrawto ( 0, -3000) }
180
IF thrust DO { IF rotforce>0 DO { setcolour(col_yellow) cpoint(-3000, 0) // Rotate left jets cdrawto( -3500, 2000) cdrawto( -2500, 2000) cdrawto( -3000, 0) cpoint( 3000,-2000) cdrawto( 2500,-4000) cdrawto( 3500,-4000) cdrawto( 3000,-2000) } IF rotforce<0 DO { setcolour(col_yellow) cpoint( 3000, 0) // Rotate right jets cdrawto( 3500, 2000) cdrawto( 2500, 2000) cdrawto( 3000, 0) cpoint(-3000,-2000) cdrawto( -2500,-4000) cdrawto( -3500,-4000) cdrawto( -3000,-2000) } }
} AND plotmoon() BE { LET x, dx = 0, 4//screenxsize/128 setcolour(col_lightblue) drawpoint(x, (height(x0)-y0)/scale) WHILE x<screenxsize DO { x := x+dx drawto(x, (height(x0+scale*x)-y0)/scale) } setcolour(col_lightmajenta) drawpoint((target-halftargetsize-x0)/scale, (height(target)-y0)/scale) drawto ((target+halftargetsize-x0)/scale, (height(target)-y0)/scale) }
5.10. MOON LANDER
181
AND displayall() BE { LET xm = screenxsize/2 LET targy = screenysize - 60 LET fuely = screenysize - 30 LET fuelxl = xm - 100 LET fuelxh = xm + 100 LET fuelx = fuelxl + muldiv(200, fuel, fuelmax) LET targx = xm + (target-cgx)/100000 LET targx1 = xm + (target-cgx)/1000000 LET tdotx = xm - thetadot/8 LET tdoty = fuely-15 LET flx0, fly0 = xm, fuely-100 LET flxs, flys = flamelength*costheta/1000, flamelength*sintheta/1000 sys(Sys_sdl, sdl_fillsurf, screen, col_darkgray) setwindow() setcolour(col_cyan) drawpoint(fuelxl, fuely) drawby(200, 0) setcolour(col_red) drawpoint(fuelx, fuely) drawby(0, 20) // Fuel
setcolour(col_lightmajenta) // Target drawpoint(targx-10, targy) drawby(20, 0) drawpoint(targx1-5, targy-2) drawby(5, 0) setcolour(col_cyan) drawpoint(xm, fuely) drawby(0, -15) setcolour(col_red) drawpoint(tdotx, tdoty) drawby(0, -15) setcolour(col_lightgreen) drawpoint(flx0, fly0) drawby(flxs/200, flys/200) // Thetadot
// Acceleration
setcolour(col_red) // Velocity drawpoint(flx0, fly0) drawby(cgxdot/10_000, cgydot/10_000)
182
{ LET x = flx0+cgxdot/200-1 LET y = fly0+cgydot/200-1 drawfillrect(x, y, x+3, y+3) // Velocity/200 } setcolour(col_white) plotf(10, 75, "target %11.3d", target-cgx) plotf(10, 60, "cgx= %11.3d xdot=%9.3d", cgx, cgxdot) plotf(10, 45, "cgy= %11.3d ydot=%9.3d", cgy, cgydot) plotf(10, 30, "fuel= %11.3d", fuel) //plotf(10, 15, "scale= %11.3d", scale) IF landed DO { LET x = screenxsize/2 LET y = screenysize/2 plotf(x, y, "Landed") IF toofast DO { IF badsite DO { IF badorientation DO { IF goodlanding DO { } plotmoon() plotcraft() ret1: updatescreen() } AND rdjoystick() = 0 AND rdn() = VALOF { LET res = 0 ch := sys(10) WHILE 0<=ch<=9 DO { res := 10*res + ch - 0 ch := sys(10) } RESULTIS res } AND sine(theta) = VALOF // theta = 0 for 0 degrees // = 64000 for 90 degrees // Returns a value in range -1000 to 1000
y y y y
:= := := :=
y-15; y-15; y-15; y-15;
plotf(x, plotf(x, plotf(x, plotf(x,
y, y, y, y,
"Too fast") } "Bad site") } "Bad orientation") } "Perfect landing -- well done!") }
5.10. MOON LANDER

{ LET a = theta / 1000 LET r = theta REM 1000 LET s = rawsine(a) RESULTIS s + (rawsine(a+1)-s)*r/1000 } AND cosine(x) = sine(x+64_000) AND rawsine(x) = VALOF { // x is scaled d.ddd with 64.000 representing 90 degrees // The result is scalled d.ddd, ie 1000 represents 1.000 LET t = TABLE 0, 25, 49, 74, 98, 122, 147, 171, 195, 219, 243, 267, 290, 314, 337, 360, 383, 405, 428, 450, 471, 493, 514, 535, 556, 576, 596, 615, 634, 653, 672, 690, 707, 724, 741, 757, 773, 788, 803, 818, 831, 845, 858, 870, 882, 893, 904, 914, 924, 933, 942, 950, 957, 964, 970, 976, 981, 985, 989, 992, 995, 997, 999, 1000, 1000 LET a = x&63 UNLESS (x&64)=0 DO a := 64-a a := t!a UNLESS (x&128)=0 DO a := -a RESULTIS a }
183
As the lander approaches the landing site, the screen should look somethine like the following.
184
5.11
A 3D Demo
The example in this section illustrates how to display a rotating object in three dimensions (3D) with hidden surface removal. When compiled and run the program will create window containing a moving image similar to the following.
5.11. A 3D DEMO
185
By pressing S you can select other possible objects to display, such as the following.
Whatever object is displayed, it will rotate with increasing speed but may be paused by pressing P and the orientation and speed of rotation may be reset by pressing R. The eye position may be moved further from the object by pressing F making it look smaller, and N moves the eye position closer. You can exit from the program by pressing Q. An important aspect of the problem is how to represent the orientation of the object being displayed. For simplicity, let us assume the object to display is an aircraft with three embedded axes, t in the direction of thrust, w in the direction of the left (port) wing and l in the direction of lift, assumed to be orthogonal to both t and w. We will call the t, w and l the body axes, not to be confused with the real world axes x, y and z. For our purposes we will assume the world is not a sphere like the earth but at with x pointing north, y pointing west and z pointing up. The orientation of the aircraft can be specied in various ways. A common way is to use Euler angles which give the amount of rotation needed to move the aircraft from a state pointing north with wings level to the required orientation. The rotations are done in a dened order such as (1) rotate about axis w, then (2) rotate about axis l and nally (3) rotate about axis t. By this means any orientation can be reached. But notice that the order in which the rotations are done is signicant. Another method, particularly favoured by implementers of ight simulators, is to use quarternions. These were discovered by an Irish mathematician William Rowan Hamilton in 1843. We are used to the idea of representing complex numbers in two dimensions with the i axis orthogonal to the real axis, and we have
186
seen multiplication of complex numbers can represent rotations and possible scaling in two dimensions. Quarternions are like complex numbers but in a higher number of dimensions. While complex numbers are typically written as a + ib, quarternions are written as a + ib + jc + kd. With complex numbers the i axis is orthogonal to the real axis, but with quartenions the mind blowing idea is that i is still orthogonal to the real axis but so are j and k and furthermore i, j and k are orthogonal to each other, so must live in a four dimentional space which is hard to visualise. As with complex numbers, multiplying by i corresponds to a rotation of 90 degrees, and i2 = 1. With quartenions, multiplying by i, j and k correspond to dierent rotations of 90 degrees and i2 = j 2 = k 2 = 1. Furthermore, Hamiltons major breakthough was the realisation that ijk also equals -1. He was so excited by this discovery that he could not resist the urge to carve i2 = j 2 = k 2 = ijk = 1 into the stone of Brougham Bridge in Dublin. Unfortunately his carving is no longer visible. From these equations it is easy to deduce that ij = k , ji = k , jk = i, kj = i, ki = j and ik = j . Notice that ij = ji, so the algebra is not commutative which is, of course, also true of rotations in three dimentions. If we multiply two quarterions a1 + b1 i + c1 j + d1 k by a2 + b2 i + c2 j + d2 k using the normal rules of algebra and simplify the result using the above equations, we obtain (a1 a2 b1 b2 c1 c2 + d1 d2 )+ (a1 b2 + b1 a2 + c1 d2 d1 c2 )i+ (a1 c2 b1 d2 + c1 a2 + d1 b2 )j + (a1 d2 + b1 c2 c1 b2 + d1 a2 )k Just as any non zero complex number has an inverse that corresponds to undoing a rotation on 2D, any non zero quarternion also has an inverse corresponding to undoing a 3D rotation. Indeed, there are two inverses depending on whether preor post- multiplication is used. Having just given a very brief introduction to quartenions with hints as to why they are useful for discribing 3D rotations, I am going to drop the idea and use yet another mechanism for describing the orientation of the aircraft. In the programs that follow, I use direction cosines. If we want to specify the direction of thrust t we can use the coordinates of a point T on the unit sphere centred at the origin O with OT parallel to the directions of thrust. In the programs that follows these coordinates are held in the variables ctx, cty and ctz. They are called direction cosines because, for instance, ctx is the cosine of the angle between the x axis and the direction of thrust. The variables cwx, cwy and cwz hold the cosines for direction w and clx, cly and clz hold the cosines for l. They are held as scaled numbers with 6 digits after the decimal point which provides adequate precision for our purposes. Using directions cosines may seem inecient since they require 9 variables rather than the three for Euler angles
5.11. A 3D DEMO
187
or four for quarternions, but they are easier to understand and use, particularly for the calculations needed to plot instruments such as the articial horizon or points on the ground as viewed by the pilot. The cost of performing rotations is insignicant compared to other computations performed by the ight simulator. The program that drew the pictures given above is called draw3d.b and it starts as follows.
MANIFEST { Sps = 20 } GLOBAL { done:ug object stepping c_elevator c_aileron c_rudder c_thrust
// Direction cosines scaling factor // ie 6 decimal digits after the decimal point. // Steps per second
// =0 for an aircraft, =1 for a hollow cube // =2 for coloured triangles // =FALSE if not rotating the object // Controls
ctx; cty; ctz cwx; cwy; cwz clx; cly; clz
// Direction cosines of direction t // Direction cosines of direction w // Direction cosines of direction l
cetx; cety; cetz // Eye direction cosines of direction t cewx; cewy; cewz // Eye direction cosines of direction w celx; cely; celz // Eye direction cosines of direction l eyex; eyey; eyez // Relative position of the eye eyedist // Eye x or y distance from aircraft rtdot; rwdot; rldot // Rotation rates about t, w and l axes
188
// Rotational forces are scaled with 6 digits after the decimal point // as are direction cosines. rft // Rotational force about t axis rfw // Rotational force about w axis rfl // Rotational force about l axis cdrawquad3d cdrawtriangle3d } // Insert the definitition of drawtigermoth() GET "drawtigermoth.b"
As can be seen this inserts the BCPL source of the SDL library and then declares the global variables used in the program. The variable done is set to TRUE when Q is pressed causing the program to terminate. The variable object specied which of four possible objects is to be drawn. The default value selects a representation of a tiger moth aircraft. The variable stepping can be set to FALSE by pressing P to temporarily stop the displayed image being rotated. As stated above the orientation of the displayed object is specied by direction cosines held in the variables such as ctx, cty and ctz. Direction cosines have a remarkable and particularly useful property which is as follows. Suppose P and Q are two points on the unit sphere with coordinates (x, y, z ) and (X, Y, Z ), respectively, the expression xX + yY + zZ is called the inner product of (x, y, z ) and (X, Y, Z ) and is often written as (x, y, z ).(X, Y, Z ). It turns out that its value is the cosine of the angle between the lines OP and OQ. We can convince ourselves that this by the following observation. If we rotate P and Q about the z-axis by some arbitary angle , they move to new positions P and Q with cordinates (x cos y sin , x sin + y cos , z ) and (X cos Y sin , X sin + Y cos , Z ). It is clear that the angle between OP and OQ is the same that between OP and OQ. We can see that this rotation did not change the inner product, since (x cos y sin , x sin + y cos , z ).(X cos Y sin , X sin + Y cos , Z ) = (x cos y sin )(X cos Y sin )+ (x sin + y cos )(X sin + Y cos ) + zZ ) = xX cos2 xY cos sin yX sin cos + yY sin2 + xX sin2 + xY sin cos + yX cos sin + yY cos2 + zZ = xX (cos2 + sin2 ) + yY (cos2 + sin2 ) + zZ = xX + yY + zZ
5.11. A 3D DEMO
189
So, if we take an arbitary pair of points P and Q on the unit sphere and rotate them about the z axis until Q is in the xz plane, then rotate them about the y-axis until Q is on the x-axis and nally rotate them about the x-axis until P is in the xy plane. Assuming the angle between the original OP and OQ was , the angle between their new positions will still be and so the new coordinates of P and Q will be (cos , sin , 0) and (1, 0, 0), and their inner product will be cos 1 + sin 0 + 0 0 = cos . This conrms that the inner product of two sets of direction cosines is the cosine of the angle between the two directions they specify. The BCPL function to calculate the inner product is dened as follows.
LET inprod(a,b,c, x,y,z) = // Return the cosine of the angle between two unit vectors. muldiv(a, x, One) + muldiv(b, y, One) + muldiv(c, z, One)
This function assumes that x, y and z are direction cosines represented by scaled numbers with 6 digits after the decimal point. The manifest constant 000000 represents one in this representation. This function is used in the denition of rotate given below.
AND rotate(t, w, l) BE { // Rotate the orientation of the aircraft // t, w and l are assumed to be small and cause // rotation about axis t, w, l. Positive values cause // anti-clockwise rotations about their axes. LET tx = inprod(One, -l, w, ctx,cwx,clx) LET wx = inprod( l,One, -t, ctx,cwx,clx) LET lx = inprod( -w, t,One, ctx,cwx,clx) LET ty = inprod(One, -l, w, cty,cwy,cly) LET wy = inprod( l,One, -t, cty,cwy,cly) LET ly = inprod( -w, t,One, cty,cwy,cly) LET tz = inprod(One, -l, w, ctz,cwz,clz) LET wz = inprod( l,One, -t, ctz,cwz,clz) LET lz = inprod( -w, t,One, ctz,cwz,clz) ctx, cty, ctz := tx, ty, tz cwx, cwy, cwz := wx, wy, wz clx, cly, clz := lx, ly, lz adjustlength(@ctx); adjustlength(@cwx); adjustlength(@clx) adjustortho(@ctx, @cwx); adjustortho(@ctx, @clx); adjustortho(@cwx, @clx) }
190
This function is used to make small changes to the orientation of the object being displayed. For simplicity we will assume the object being displayed is an aircraft. Embedded in the aircraft are three axes: t with direction cosines ctx, cty and ctz, w with direction cosines cwx, cwy and cwz, and l with direction cosines clx, cly and clz. The arguments of t, w and l are in radians specifying small anti-cloclockwise rotations about the t-, w- and l- axes, respectively. These angles are also scaled with 6 digits after the decimal point. The variables tx, ty and tz are approximately the directions cosines of axis t after the rotation, and these are calculated using suitable calles of inprod. Consider the call inprod(One,-l,w, ctx,cwx,clx) that denes tx which will be the new value of ctx. To see how it works, consider the eect of -l in the inner product. This should give the amount by which ctx is increased due to the small rotation about the l axis. The inprod call computes this increase as muldiv(-l,cwx,One). If T is the point on the unit sphere in direction t from the origin, then this small rotation will move it to a point T in the tw plane by a distance l. If is the angle between T T and the yz plane, then the change in ctx will be l sin , but T T is parallel to the w axis and so sin is equal to cwx. Thus the magnitude of the change is l multiplied by cwx and since the rotation was anti-clockwise this value is negated. The other rotations may be checked in the same way. Since the calculations will inevitably be approximate, two adjustments are made to the new direction cosines. The calls adjustlength to attempt to ensure the direction cosines remain of unit length, and the calls adjustortho that attempts to keep the three direction cosines mutually orthogonal. These functions are dened as follows.
AND adjustlength(v) BE { // This helps to keep vector v of unit length LET x, y, z = v!0, v!1, v!2 LET corr = One + (inprod(x,y,z, x,y,z) - One)/2 v!0 := muldiv(x, One, corr) v!1 := muldiv(y, One, corr) v!2 := muldiv(z, One, corr) }
If we write the distance from O to (x, y, z ) as (1 + ), the call inprod(x,y,z, x,y,z) yields the square of this length, namely (1 + )2 which equals (1 + 2 + 2 ). Provided is small this is approximately (1 + 2 ) and so an estimate of is (inprod(x,y,z, x,y,z) - One)/2. The length correction requires us to divide x by (1 + ) which is exactly what v!0 := muldiv(x, One, corr) does since corr is set to (1 + ). The corrections to y and z are done in the same way. The function adjustortho is dened as follows.
AND adjustortho(a, b) BE
5.11. A 3D DEMO
{ // This helps to keep the unit vector b orthogonal to a LET a0, a1, a2 = a!0, a!1, a!2 LET b0, b1, b2 = b!0, b!1, b!2 LET corr = inprod(a0,a1,a2, b0,b1,b2) b!0 := b0 - muldiv(a0, corr, One) b!1 := b1 - muldiv(a1, corr, One) b!2 := b2 - muldiv(a2, corr, One) }
191
In this function, the call inprod(a0,a1,a2, b0,b1,b2) computes a value that will be zero if the two sets of direction cosines are orthogonal. If not zero, the correction should be small and this proportion of a is subtracted from b. To demonstrate the need for these two corrections, try commenting out the calls of adjustlength and adjustortho. You will nd that the images generated by draw3d soon get seriously distorted. The object being displayed is rotating at a rate held in the variables rtdot, rwdot and rldot. These are scaled values with six digits after the decimal point representing anti-clockwise rotations rates about the t, w and l axes in radians per second. The orientation of the object is updated many times per second by calls of step. Its denition is as follows.
LET step() { // Apply rtdot := rwdot := rldot := BE rotational forces -c_aileron * 200 / Sps -c_elevator * 200 / Sps c_rudder * 200 / Sps
rotate(rtdot/Sps, rwdot/Sps, rldot/Sps) }
The number of times step is called per second is held in Sps. So on each call the angle of rotation about the t-axis is rtdot/Sps. The rotational angles for the other two axes are calculated in the same way. Every time step is called the rotational rates are adjusted by rotational forces held in rft, rfw and rfl. These are in units of radians per second per second and are adjusted to suit the stepping rate. In a ight simulator these forces depend on the speed and direction of the airow around the aircraft and the setting of the ying controls such as the elevator or rudder. In draw3d.b these controls can be modied using the arrow keys and the characters < and >. The distance between the eye and the object can be modied by pressing F and N. The object is displayed by calling plotcraft dened as follows.
192
AND plotcraft() BE { IF depthscreen FOR i = 0 TO screenxsize*screenysize-1 DO depthscreen!i := maxint IF object=0 DO { // Simple aircraft setcolour(maprgb(64,128,64)) // Fuselage cdrawtriangle3d(6_000,0,0, 2_000,0,-1_000, -2_000,0,2_000) setcolour(maprgb(40,100,40)) cdrawtriangle3d(2_000,0,-1_000, -2_000,0,2_000, -12_000,0,0) setcolour(maprgb(255,255,255)) cdrawtriangle3d(2_000,0, 1_000, -2_000,0,2_000, 0_800,0,2_000) setcolour(maprgb(255,0,0)) // Port wing -- Red cdrawtriangle3d(2_500,0,0, -2_500,0,0, -2_000, 18_000,2_000) setcolour(maprgb(0,255,0)) // Starboard wing -- Green cdrawtriangle3d(2_500,0,0, -2_500,0,0, -2_000,-18_000,2_000) setcolour(maprgb(255,0,255)) // Stabliser cdrawtriangle3d(-9_000,0,0, -12_000,0,0, -13_000,-4_000,0) setcolour(maprgb(255,255,0)) cdrawtriangle3d(-9_000,0,0, -12_000,0,0, -13_000, 4_000,0) setcolour(maprgb(0,255,255)) // Fin cdrawtriangle3d(-9_000,0,0, -12_000,0,0, } IF object=1 DO { // Create a coloured cube with side length 2s LET s = 10_000 setcolour(maprgb(0,0,0)) // Front cdrawquad3d(s,-s,s, s,s,s, s,s,-s, s,-s,-s) setcolour(maprgb(255,255,255)) // Back cdrawquad3d(-s,-s,s, -s,s,s, -s,s,-s, -s,-s,-s) setcolour(maprgb(255,0,0)) // Left cdrawquad3d( s,s,s, s,s,-s, -s,s,-s, -s,s,s) setcolour(maprgb(0,255,0)) // Right cdrawquad3d( s,-s,s, s,-s,-s, -s,-s,-s, -s,-s,s) } IF object=2 DO { LET s = 10_000 LET r = muldiv(s, c_thrust, 32768)
-13_000,0,4_000)
5.11. A 3D DEMO
193
// top setcolour(maprgb(0,0,0)) cdrawquad3d( r,0,s, 0,r,s,
-r,0,s,
0,-r,s)
// top wings setcolour(maprgb(255,0,0)) cdrawtriangle3d( r, 0, s, s, 0, setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0, r, s, 0, s, setcolour(maprgb(255,0,0)) cdrawtriangle3d(-r, 0, s, -s, 0, setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0,-r, s, 0,-s, // Sides setcolour(maprgb(128,0,0)) cdrawquad3d(s,0,r, s,r,0,
s, s,
s, 0, r) // N 0, s, r) // W
s, -s, 0, r) // S s, 0,-s, r) // E
s,0,-r,
s,-r,0)
// N
setcolour(maprgb(255,128,0)) cdrawquad3d(0,s,r, r,s,0, 0,s,-r, setcolour(maprgb(255,0,128)) cdrawquad3d(-s,0,r, -s,r,0,
-r,s,0)
// W
-s,0,-r,
-s,-r,0) // S
setcolour(maprgb(255,128,128)) cdrawquad3d(0,-s,r, r,-s,0, 0,-s,-r, // Centre wings setcolour(maprgb(255,128,0)) cdrawtriangle3d( s, s, 0, r, s, setcolour(maprgb(0,255,128)) cdrawtriangle3d(-s, s, 0, -s, r, setcolour(maprgb(128,0,255)) cdrawtriangle3d(-s,-s, 0, -r,-s, setcolour(maprgb(127,255,255)) cdrawtriangle3d( s,-s, 0, s,-r,
-r,-s,0) // W
0,
s, r, 0) // NW
0, -r, s, 0) // SW 0, -s,-r, 0) // SE 0, r,-s, 0) // NE
// bottom wings setcolour(maprgb(255,0,0)) cdrawtriangle3d( r, 0,-s, s, 0,-s, s, 0,-r) // N setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0, r,-s, 0, s,-s, 0, s,-r) // W setcolour(maprgb(255,0,255)) cdrawtriangle3d(-r, 0,-s, -s, 0,-s, -s, 0,-r) // S
194

setcolour(maprgb(0,255,255)) cdrawtriangle3d( 0,-r,-s, 0,-s,-s,
0,-s,-r) // E
// Bottom setcolour(maprgb(128,128,128)) cdrawquad3d( r,0,-s, 0,r,-s, -r,0,-s, } IF object=3 DO { // Tigermoth drawtigermoth() } }
0,-r,-s)
This function inspects object to see which object to draw drawing it with successive calls of cdrawquad3d or cdrawtiangle3d. The objects are specied using body coordinates in directions t,w and l, using values representing feet scaled with three digits after the decimal point. The function cdrawquad3d draws a 3D quadrilateral by rst rotating the coordinates using suitable calls of inprod then transforming them to screen coordinates using screencoords before ploting the quadrilateral using the library function drawquad3d, dened in sdl.b.
AND cdrawquad3d(x1,y1,z1, x2,y2,z2, x3,y3,z3, x4,y4,z4) BE { LET rx1 = inprod(x1,y1,z1, ctx,cwx,clx) LET ry1 = inprod(x1,y1,z1, cty,cwy,cly) LET rz1 = inprod(x1,y1,z1, ctz,cwz,clz) LET rx2 = inprod(x2,y2,z2, ctx,cwx,clx) LET ry2 = inprod(x2,y2,z2, cty,cwy,cly) LET rz2 = inprod(x2,y2,z2, ctz,cwz,clz) LET rx3 = inprod(x3,y3,z3, ctx,cwx,clx) LET ry3 = inprod(x3,y3,z3, cty,cwy,cly) LET rz3 = inprod(x3,y3,z3, ctz,cwz,clz) LET rx4 = inprod(x4,y4,z4, ctx,cwx,clx) LET ry4 = inprod(x4,y4,z4, cty,cwy,cly) LET rz4 = inprod(x4,y4,z4, ctz,cwz,clz) LET LET LET LET sx1,sy1,sz1 sx2,sy2,sz2 sx3,sy3,sz3 sx4,sy4,sz4 = = = = ?,?,? ?,?,? ?,?,? ?,?,?
5.11. A 3D DEMO
195
UNLESS UNLESS UNLESS UNLESS
screencoords(rx1-eyex, screencoords(rx2-eyex, screencoords(rx3-eyex, screencoords(rx4-eyex,
ry1-eyey, ry2-eyey, ry3-eyey, ry4-eyey,
rz1-eyez, rz2-eyez, rz3-eyez, rz4-eyez,
@sx1) @sx2) @sx3) @sx4)
RETURN RETURN RETURN RETURN
drawquad3d(sx1,sy1,sz1, sx2,sy2,sz2, sx3,sy3,sz3, sx4,sy4,sz4) }
The function cdrawtriangle3d does the same job for 3D triangles. It denition is as follows.
AND cdrawtriangle3d(x1,y1,z1, x2,y2,z2, x3,y3,z3) BE { LET rx1 = inprod(x1,y1,z1, ctx,cwx,clx) LET ry1 = inprod(x1,y1,z1, cty,cwy,cly) LET rz1 = inprod(x1,y1,z1, ctz,cwz,clz) LET rx2 = inprod(x2,y2,z2, ctx,cwx,clx) LET ry2 = inprod(x2,y2,z2, cty,cwy,cly) LET rz2 = inprod(x2,y2,z2, ctz,cwz,clz) LET rx3 = inprod(x3,y3,z3, ctx,cwx,clx) LET ry3 = inprod(x3,y3,z3, cty,cwy,cly) LET rz3 = inprod(x3,y3,z3, ctz,cwz,clz) LET sx1,sy1,sz1 = ?,?,? LET sx2,sy2,sz2 = ?,?,? LET sx3,sy3,sz3 = ?,?,? UNLESS screencoords(rx1-eyex, ry1-eyey, rz1-eyez, @sx1) RETURN UNLESS screencoords(rx2-eyex, ry2-eyey, rz2-eyez, @sx2) RETURN UNLESS screencoords(rx3-eyex, ry3-eyey, rz3-eyez, @sx3) RETURN drawtriangle3d(sx1,sy1,sz1, sx2,sy2,sz2, sx3,sy3,sz3) }
Both cdrawquad3d and cdrawtriangle3d use screencoords to transform the rotated coordinates of an object to screen coordinates, taking account of the orientation of the observers eye held in directions cosines such as cetx, cewx and celx.
AND screencoords(x,y,z, v) = VALOF { // If the point (x,y,z) is in view, set v!0, v!1 and v!2 to // the screen coordinates and depth and return TRUE
196
// otherwise return FALSE LET sx = inprod(x,y,z, cewx,cewy,cewz) // LET sy = inprod(x,y,z, celx,cely,celz) // LET sz = inprod(x,y,z, cetx,cety,cetz) // LET screensize = screenxsize>=screenysize
Horizontal Vertical Depth -> screenxsize, screenysize
// Test that the point is in view, ie at least 1.000ft in front // and no more than about 27 degrees (inverse tan 1/2) from the // direction of view. IF sz<1_000 & muldiv(sz, sz, 2000) >= muldiv(sx, sx, 1000) + muldiv(sy, sy, 1000) RESULTIS FALSE // A point screensize pixels away from the centre of the screen is // 45 degrees from the direction of view. // Note that many pixels in this range are off the screen. v!0 := -muldiv(sx, screensize, sz) + screenxsize/2 v!1 := +muldiv(sy, screensize, sz) + screenysize/2 v!2 := sz // This distance into the screen in arbitrary units, used // for hidden surface removal. RESULTIS TRUE }
The arguments x, y, z are the coordinates of a point relative to the position of the eye. As can be seen, screencoords checks that the point in at least one foot in front of the observer and no more than about 27 degrees from the direction of view. If successful it updates the three elements of vector v with the horizontal, vertical and depth screen coordinates of the point, returning TRUE to indicate success. Otherwise it returns FALSE. The depth coordinate is used by the low level plotting functions to conditionally remove points obscured by a previously drawn points. The function plotscreen is called every time the screen has to be updated. It rst lls it with a light blue colour, then sets the eye position and orientation before plotting calling plotcraft to draw the object.
AND plotscreen() BE { fillscreen(maprgb(100,100,255)) seteyeposition() plotcraft() }
In this program, the orientation of the eye is always looking horizontally due north and is positioned at a distance eyedist due south of the centre of the object. As described above, this distance can be adjusted by typing F or N.
5.11. A 3D DEMO
AND seteyeposition() BE { cetx, cety, cetz := One, 0, 0 cewx, cewy, cewz := 0, One, 0 celx, cely, celz := 0, 0, One eyex, eyey, eyez := -eyedist, 0, 0 }
197
// Relative eye position
The program is controlled using the mouse and keyboard. These interactions are dealt with by processevents whose denition is as follows.
AND processevents() BE WHILE getevent() SWITCHON eventtype INTO { DEFAULT: LOOP CASE sdle_keydown: SWITCHON capitalch(eventa2) INTO { DEFAULT: LOOP CASE Q: done := TRUE LOOP CASE S: // Select next object to display object := (object + 1) MOD 4 LOOP CASE P: // Toggle stepping stepping := ~stepping LOOP CASE R: // Reset the orientation and rotation rate ctx, cty, ctz := One, 0, 0 cwx, cwy, cwz := 0, One, 0 clx, cly, clz := 0, 0, One rtdot, rwdot, rldot := 0, 0, 0 LOOP CASE N: // Reduce eye distance eyedist := eyedist*5/6 IF eyedist<65_000 DO eyedist := 65_000 LOOP CASE F: // Increase eye distance eyedist := eyedist*6/5 LOOP
198

CASE Z: c_thrust := c_thrust-2048 IF c_thrust<0 DO c_thrust := 0 writef("c_thrust=%n*n", c_thrust) LOOP CASE X: c_thrust := c_thrust+2048 IF c_thrust>32768 DO c_thrust := 32768 writef("c_thrust=%n*n", c_thrust) LOOP CASE ,: CASE <: c_rudder := c_rudder - 4096 IF c_rudder<-32768 DO c_rudder := -32768 writef("c_rudder=%n*n", c_rudder) LOOP CASE .: CASE >: c_rudder := c_rudder + 4096 IF c_rudder> 32768 DO c_rudder := 32768 writef("c_rudder=%n*n", c_rudder) LOOP CASE sdle_arrowup: c_elevator := c_elevator+4096 IF c_elevator> 32768 DO c_elevator := 32768 writef("c_elevator=%n*n", c_elevator) LOOP CASE sdle_arrowdown: c_elevator := c_elevator-4096 IF c_elevator< -32768 DO c_elevator := -32768 writef("c_elevator=%n*n", c_elevator) LOOP CASE sdle_arrowright: c_aileron := c_aileron+4096 IF c_aileron> 32768 DO c_aileron := 32768 writef("c_aileron=%n*n", c_aileron) LOOP CASE sdle_arrowleft: c_aileron := c_aileron-4096 IF c_aileron< -32768 DO c_aileron := -32768 writef("c_aileron=%n*n", c_aileron) LOOP }
CASE sdle_quit:
5.11. A 3D DEMO
writef("QUIT*n"); done := TRUE LOOP }
199
Events are read by calls of getevent which returns TRUE whenever another event is present. The type of event is placed in eventtype. If it is a key down event from the keyboard eventtype=sdle keydown and eventa2 identies which key was pressed. The SWITCHON command has cases for each key that aects to program. The code for each is easy to follow. All other keys are ignored at the DEFAULT label. The only mouse event to be handled has type sdle quit caused by clicking on the little cross at the top right hand corner of the window. As can be seen this sets done to TRUE causing the program to terminate. Finally, there is the main program start which initialises the variables used by the program, creates a window entitled Draw 3D Demo and enters the main processing loop which repeatedly calls processevents to deal with keyboard and mouse events, before conditionally calling step to rotate the object, followed by calls plotscreen and updatescreen to draw the new state of the object and send it to the display hardware. It then issues a short delay before going round the loop again. It only leaves the loop when done becomes TRUE. This delays briey before closing the SDL window and terminating the program. The denition of start is as follows.
LET start() = VALOF { // The initial direction cosines giving the orientation of // the object. ctx, cty, ctz := One, 0, 0 // The cosines are scaled with cwx, cwy, cwz := 0, One, 0 // six decimal digits clx, cly, clz := 0, 0, One // after to decimal point. eyedist := 120_000 // Eye distance from the object. object := 3 // Tigermoth stepping := TRUE // Initial rate of rotation about each axis rtdot, rwdot, rldot := 0, 0, 0 c_elevator, c_aileron, c_rudder, c_thrust := -4096*4, 4096*3, 4096*5, 10240 initsdl() mkscreen("Draw 3D Demo", 800, 500) done := FALSE UNTIL done DO { processevents()
200

IF stepping DO step() plotscreen() updatescreen() sdldelay(50)
} writef("*nQuitting*n") sdldelay(1_000) closesdl() RESULTIS 0 }
5.12
drawtigermoth.b
This le contains the denition of the function drawtigermoth. It was developed using draw3d.b and is the aircraft used in the ight simulator that follows. It is in a seperate le so that it can be inserted in both programs by the directive GET "drawtigermoth.b". A typical image of the aircraft is as follows.
The denition of drawtigermoth is as follows.

LET drawtigermoth() BE { // The origin is the centre of gravity // All measurements are in feet scaled with three // digits after the decimal point. // Cockpit floor
5.12. DRAWTIGERMOTH.B
setcolour(maprgb(90,80,30)) cdrawquad3d (1_000, 0_800, 0_000, 1_000,-0_800, 0_000, -5_800,-0_800, 0_000, -5_800, 0_800, 0_000)
201
// Left lower wing setcolour(maprgb(165,165,30)) cdrawquad3d(-0_500, -3_767, -4_396, -1_129, cdrawquad3d(-3_767, -4_917, -5_546, -4_396, 1_000, 1_000, 6_000, 6_000, 1_000, 1_000, 6_000, 6_000, -2_000, -2_218, -1_745, -1_527) -2_218, -2_294, -1_821, -1_745)
// Under surface // Panel A
// Panel B
cdrawquad3d(-1_129, 6_000, -1_527, -4_396, 6_000, -1_745, -5_147, 14_166, -1_179, -1_880, 14_166, -0_961)
// Panel C
{ // Aileron deflection 1 inch from hinge LET a = muldiv(0_600, c_aileron, 32_768*17) setcolour(maprgb(155,155,20)) cdrawquad3d(-4_396, 6_000, -5_546+3*a, 6_000, -6_297+3*a, 13_766, -5_147, 14_166, } // Left lower wing upper surface setcolour(maprgb(120,140,60)) cdrawquad3d(-0_500, -1_500, -2_129, -1_129, 1_000, 1_000, 6_000, 6_000, -2_000, -1_800, -1_327, -1_527) // Panel A1 // Under surface -1_745, // Panel D Aileron -1_821-14*a, -1_255-14*a, -1_179)
setcolour(maprgb(120,130,50)) cdrawquad3d(-1_500, 1_000, -1_800,
// Panel A2
202

-3_767, -4_396, -2_129, 1_000, -2_118, 6_000, -1_645, 6_000, -1_327) 1_000, 1_000, 6_000, 6_000, -2_118, -2_294, -1_821, -1_645) // Panel B
cdrawquad3d(-3_767, -4_917, -5_546, -4_396,
setcolour(maprgb(120,140,60)) cdrawquad3d(-1_129, 6_000, -1_527, -2_129, 6_000, -1_327, -2_880, 14_166, -0_761, -1_880, 14_166, -0_961) setcolour(maprgb(120,130,50)) cdrawquad3d(-2_129, 6_000, -1_327, -4_396, 6_000, -1_645, -5_147, 14_166, -1_079, -2_880, 14_166, -0_761)
// Panel C1
// Panel C2
{ // Aileron deflection 1 inch from hinge LET a = muldiv(0_600, c_aileron, 32_768*17) setcolour(maprgb(120,140,60)) cdrawquad3d(-4_396, 6_000, -5_546+3*a, 6_000, -6_297+3*a, 13_766, -5_147, 14_166, } // Left lower wing tip setcolour(maprgb(130,150,60)) cdrawtriangle3d(-1_880, 14_167,-1_006, -2_880, 14_167,-0_761, -3_880, 14_467,-0_980) setcolour(maprgb(130,150,60)) cdrawtriangle3d(-2_880, 14_167,-0_761, -5_147, 14_167,-1_079, -3_880, 14_467,-0_980) setcolour(maprgb(160,160,40)) cdrawtriangle3d(-5_147, 14_167,-1_079, -5_147, 14_167,-1_179, -3_880, 14_467,-0_980) setcolour(maprgb(170,170,50))
-1_645, // Panel D Aileron -1_821-14*a, -1_255-14*a, -0_979)
cdrawtriangle3d(-5_147, 14_167,-1_179, -1_880, 14_167,-0_961, -3_880, 14_467,-0_980) // Right lower wing setcolour(maprgb(165,165,30)) cdrawquad3d(-0_500, -3_767, -4_396, -1_129, cdrawquad3d(-3_767, -4_917, -5_546, -4_396, -1_000, -1_000, -6_000, -6_000, -1_000, -1_000, -6_000, -6_000, -2_000, -2_218, -1_745, -1_527) -2_218, -2_294, -1_821, -1_745) -1_527, -1_745, -1_179, -0_961)
203
// Under surface // Panel A
// Panel B
cdrawquad3d(-1_129, -6_000, -4_396, -6_000, -5_147,-14_166, -1_880,-14_166,
// Panel C
{ // Aileron deflection 1 inch from hinge LET a = muldiv(0_600, c_aileron, 32_768*17) setcolour(maprgb(155,155,20)) cdrawquad3d(-4_396, -6_000, -5_546+3*a, -6_000, -6_297+3*a,-13_766, -5_147, -14_166, } // Right lower wing upper surface setcolour(maprgb(120,140,60)) cdrawquad3d(-0_500, -1_500, -2_129, -1_129, -1_000, -1_000, -6_000, -6_000, -2_000, -1_800, -1_327, -1_527) // Panel A1 // Under surface -1_745, // Panel D Aileron -1_821+14*a, -1_255+14*a, -1_179)
setcolour(maprgb(120,130,50)) cdrawquad3d(-1_500, -1_000, -1_800, -3_767, -1_000, -2_118, -4_396, -6_000, -1_645, -2_129, -6_000, -1_327)
// Panel A2
204
cdrawquad3d(-3_767, -4_917, -5_546, -4_396,
-1_000, -1_000, -6_000, -6_000,
-2_118, -2_294, -1_821, -1_645)
// Panel B
setcolour(maprgb(120,140,60)) cdrawquad3d(-1_129, -6_000, -1_527, -2_129, -6_000, -1_327, -2_880,-14_166, -0_761, -1_880,-14_166, -0_961) setcolour(maprgb(120,130,50)) cdrawquad3d(-2_129, -6_000, -1_327, -4_396, -6_000, -1_645, -5_147,-14_166, -1_079, -2_880,-14_166, -0_761)
// Panel C1
// Panel C2
{ // Aileron deflection 1 inch from hinge LET a = muldiv(0_600, c_aileron, 32_768*17) setcolour(maprgb(120,140,60)) cdrawquad3d(-4_396, -6_000, -5_546+3*a, -6_000, -6_297+3*a,-13_766, -5_147, -14_166, } // Right lower wing tip setcolour(maprgb(130,150,60)) cdrawtriangle3d(-1_880,-14_167,-1_006, -2_880,-14_167,-0_761, -3_880,-14_467,-0_980) setcolour(maprgb(130,150,60)) cdrawtriangle3d(-2_880,-14_167,-0_761, -5_147,-14_167,-1_079, -3_880,-14_467,-0_980) setcolour(maprgb(160,160,40)) cdrawtriangle3d(-5_147,-14_167,-1_079, -5_147,-14_167,-1_179, -3_880,-14_467,-0_980) setcolour(maprgb(170,170,50)) cdrawtriangle3d(-5_147,-14_167,-1_179, -1_880,-14_167,-0_961, -3_880,-14_467,-0_980)
-1_645, // Panel D Aileron -1_821+14*a, -1_255+14*a, -0_979)
205
// Left upper wing setcolour(maprgb(200,200,30)) // Under surface cdrawquad3d( 1_333, 1_000, 2_900, -1_967, 1_000, 2_671, -3_297, 14_167, 3_671, 0_003, 14_167, 3_894) cdrawquad3d(-1_967, 1_000, 2_671, -3_084, 2_200, 2_606, -4_414, 13_767, 3_645, -3_297, 14_167, 3_671) setcolour(maprgb(150,170,90)) // Top surface cdrawquad3d( 1_333, 1_000, 2_900, // Panel A1 0_333, 1_000, 3_100, -0_997, 14_167, 4_094, 0_003, 14_167, 3_894) setcolour(maprgb(140,160,80)) // Top surface cdrawquad3d( 0_333, 1_000, 3_100, // Panel A2 -1_967, 1_000, 2_771, -3_297, 14_167, 3_771, -0_997, 14_167, 4_094) setcolour(maprgb(150,170,90)) // Top surface cdrawquad3d(-1_967, 1_000, 2_771, // Panel B -3_084, 2_200, 2_606, -4_414, 13_767, 3_645, -3_297, 14_167, 3_771) // Left upper wing tip setcolour(maprgb(130,150,60)) cdrawtriangle3d( 0_003, 14_167, -0_997, 14_167, -1_997, 14_467, setcolour(maprgb(130,150,60)) cdrawtriangle3d(-0_997, 14_167, -3_297, 14_167, -1_997, 14_467, setcolour(maprgb(160,160,40)) cdrawtriangle3d(-3_297, 14_167, -3_297, 14_167, -1_997, 14_467, setcolour(maprgb(170,170,50)) cdrawtriangle3d(-3_297, 14_167,
3_894, 4_094, 3_874) 4_094, 3_771, 3_874) 3_771, 3_671, 3_874) 3_671,
206

0_003, 14_167, 3_894, -1_997, 14_467, 3_874)
// Right upper wing setcolour(maprgb(200,200,30)) // Under surface cdrawquad3d( 1_333, -1_000, 2_900, -1_967, -1_000, 2_671, -3_297,-14_167, 3_671, 0_003,-14_167, 3_894) cdrawquad3d(-1_967, -1_000, 2_671, -3_084, -2_200, 2_606, -4_414,-13_767, 3_645, -3_297,-14_167, 3_671) setcolour(maprgb(150,170,90)) // Top surface cdrawquad3d( 1_333, -1_000, 2_900, // Panel A1 0_333, -1_000, 3_100, -0_997,-14_167, 4_094, 0_003,-14_167, 3_894) setcolour(maprgb(140,160,80)) // Top surface cdrawquad3d( 0_333, -1_000, 3_100, // Panel A2 -1_967, -1_000, 2_771, -3_297,-14_167, 3_771, -0_997,-14_167, 4_094) setcolour(maprgb(150,170,90)) // Top surface cdrawquad3d(-1_967, -1_000, 2_771, // Panel B -3_084, -2_200, 2_606, -4_414,-13_767, 3_645, -3_297,-14_167, 3_771) // Right upper wing tip setcolour(maprgb(130,150,60)) cdrawtriangle3d( 0_003,-14_167, -0_997,-14_167, -1_997,-14_467, setcolour(maprgb(130,150,60)) cdrawtriangle3d(-0_997,-14_167, -3_297,-14_167, -1_997,-14_467, setcolour(maprgb(160,160,40)) cdrawtriangle3d(-3_297,-14_167, -3_297,-14_167,
3_894, 4_094, 3_874) 4_094, 3_771, 3_874) 3_771, 3_671,
-1_997,-14_467, setcolour(maprgb(170,170,50)) cdrawtriangle3d(-3_297,-14_167, 0_003,-14_167, -1_997,-14_467, 3_874) 3_671, 3_894, 3_874)
207
// Wing root strut forward left setcolour(maprgb(80,80,80)) cdrawquad3d( 0_433, 0_950, 2_900, 0_633, 0_950, 2_900, 0_633, 1_000, 0, 0_433, 1_000, 0) // Wing root strut rear left setcolour(maprgb(80,80,80)) cdrawquad3d( -1_967, 0_950, -1_767, 0_950, -0_868, 1_000, -1_068, 1_000,
2_616, 2_616, 0, 0)
// Wing root strut diag left setcolour(maprgb(80,80,80)) cdrawquad3d( 0_433, 0_950, 2_900, 0_633, 0_950, 2_900, -0_868, 1_000, 0, -1_068, 1_000, 0) // Wing root strut forward right setcolour(maprgb(80,80,80)) cdrawquad3d( 0_433, -0_950, 2_900, 0_633, -0_950, 2_900, 0_633, -1_000, 0, 0_433, -1_000, 0) // Wing root strut rear right setcolour(maprgb(80,80,80)) cdrawquad3d( -1_967, -0_950, 2_616, -1_767, -0_950, 2_616, -0_868, -1_000, 0, -1_068, -1_000, 0) // Wing root strut diag right setcolour(maprgb(80,80,80)) cdrawquad3d( 0_433, -0_950, 2_900,
208

0_633, -0_950, 2_900, -0_868, -1_000, 0, -1_068, -1_000, 0)
// Wing strut forward left setcolour(maprgb(80,80,80)) cdrawquad3d( -2_200, 10_000, -1_120, -2_450, 10_000, -1_120, -0_550, 10_000, 3_315, -0_300, 10_000, 3_315) // Wing strut rear left setcolour(maprgb(80,80,80)) cdrawquad3d( -4_500, 10_000, -1_260, -4_750, 10_000, -1_260, -2_850, 10_000, 3_210, -2_500, 10_000, 3_210) // Wing strut forward right setcolour(maprgb(80,80,80)) cdrawquad3d( -2_200, -10_000, -1_120, -2_450, -10_000, -1_120, -0_550, -10_000, 3_315, -0_300, -10_000, 3_315) // Wing strut rear right setcolour(maprgb(80,80,80)) cdrawquad3d( -4_500, -10_000, -1_260, -4_750, -10_000, -1_260, -2_850, -10_000, 3_210, -2_500, -10_000, 3_210) // Wheel strut left setcolour(maprgb(80,80,80)) cdrawquad3d( -0_768, 1_000, -1_168, 1_000, -0_468, 2_000, -0_068, 2_000, // Wheel strut diag left setcolour(maprgb(80,80,80)) cdrawquad3d( 1_600, 1_000, 1_800, 1_000, -0_368, 2_000, -0_168, 2_000,
-2_000, -2_000, -3_800, -3_800)
-2_000, -2_000, -3_800, -3_800)
209
// Wheel strut centre left setcolour(maprgb(80,80,80)) cdrawquad3d( -0_500, 0_000, -0_650, 0_000, -0_318, 2_000, -0_168, 2_000, // Wheel strut right setcolour(maprgb(80,80,80)) cdrawquad3d( -0_768, -1_000, -1_168, -1_000, -0_468, -2_000, -0_068, -2_000, // Wheel strut diag right setcolour(maprgb(80,80,80)) cdrawquad3d( 1_600, -1_000, 1_800, -1_000, -0_368, -2_000, -0_168, -2_000, // Wheel strut centre right setcolour(maprgb(80,80,80)) cdrawquad3d( -0_500, -0_000, -0_650, -0_000, -0_318, -2_000, -0_168, -2_000,
-2_900, -2_900, -3_800, -3_800)
-2_000, -2_000, -3_800, -3_800)
-2_000, -2_000, -3_800, -3_800)
-2_900, -2_900, -3_800, -3_800)
// Left wheel setcolour(maprgb(20,20,20)) cdrawquad3d( -0_268, 2_100, -0_268, 2_100, -0_268-0_500, 2_100, -0_268-0_700, 2_100, cdrawquad3d( -0_268, 2_100, -0_268, 2_100, -0_268+0_500, 2_100, -0_268+0_700, 2_100, cdrawquad3d( -0_268, 2_100, -0_268, 2_100, -0_268-0_500, 2_100, -0_268-0_700, 2_100, cdrawquad3d( -0_268, 2_100,
-3_800, -3_800-0_700, -3_800-0_500, -3_800) -3_800, -3_800-0_700, -3_800-0_500, -3_800) -3_800, -3_800+0_700, -3_800+0_500, -3_800) -3_800,
210

-0_268, 2_100, -3_800+0_700, -0_268+0_500, 2_100, -3_800+0_500, -0_268+0_700, 2_100, -3_800)
// Right wheel setcolour(maprgb(20,20,20)) cdrawquad3d( -0_268, -2_100, -0_268, -2_100, -0_268-0_500,-2_100, -0_268-0_700,-2_100, cdrawquad3d( -0_268, -2_100, -0_268, -2_100, -0_268+0_500,-2_100, -0_268+0_700,-2_100, cdrawquad3d( -0_268, -2_100, -0_268, -2_100, -0_268-0_500,-2_100, -0_268-0_700,-2_100, cdrawquad3d( -0_268, -2_100, -0_268, -2_100, -0_268+0_500,-2_100, -0_268+0_700,-2_100,
-3_800, -3_800-0_700, -3_800-0_500, -3_800) -3_800, -3_800-0_700, -3_800-0_500, -3_800) -3_800, -3_800+0_700, -3_800+0_500, -3_800) -3_800, -3_800+0_700, -3_800+0_500, -3_800)
// Fueltank front setcolour(maprgb(200,200,230)) cdrawquad3d( 1_333, 1_000, 2_900, 1_333, -1_000, 2_900, 0_033, -1_000, 3_100, 0_033, 1_000, 3_100) // Fueltank back setcolour(maprgb(180,180,210)) cdrawquad3d( 0_033, 1_000, 3_100, 0_033, -1_000, 3_100, -1_967, -1_000, 2_616, -1_967, 1_000, 2_616)
// Top surface
// Top surface
// Fueltank left side setcolour(maprgb(160,160,190)) cdrawtriangle3d( 1_333, 1_000, 2_900, 0_033, 1_000, 3_100, -1_967, 1_000, 2_616) // Fueltank right side
setcolour(maprgb(160,160,190)) cdrawtriangle3d(-0_500+1_833, -1_000, -2_000+4_900, -1_800+1_833, -1_000, -1_800+4_900, -3_800+1_833, -1_000, -2_284+4_900) // Fuselage // Prop shaft setcolour(maprgb(40,40,90)) cdrawtriangle3d( 5_500, 0, 0, 4_700, 0_200, 0_300, 4_700, 0_200,-0_300) setcolour(maprgb(60,60,40)) cdrawtriangle3d( 5_500, 0, 0, 4_700, 0_200,-0_300, 4_700,-0_200,-0_300) setcolour(maprgb(40,40,90)) cdrawtriangle3d( 5_500, 0, 0, 4_700,-0_200,-0_300, 4_700,-0_200, 0_300) setcolour(maprgb(60,60,40)) cdrawtriangle3d( 5_500, 0, 0, 4_700,-0_200, 0_300, 4_700, 0_200, 0_300)
211
// Engine front lower centre setcolour(maprgb(140,140,160)) cdrawtriangle3d( 5_000, 0, 0, 4_500, 0_550, -1_750, 4_500,-0_550, -1_750) // Engine front lower left setcolour(maprgb(140,120,130)) cdrawtriangle3d( 5_000, 0, 0, 4_500, 0_550, -1_750, 4_500, 0_550, 0) // Engine front lower right setcolour(maprgb(140,120,130)) cdrawtriangle3d( 5_000, 0, 0, 4_500,-0_550, -1_750, 4_500,-0_550, 0) // Engine front upper centre
212
setcolour(maprgb(140,140,160)) cdrawtriangle3d( 5_000, 0, 0, 4_500, 0_550, 0_500, 4_500,-0_550, 0_500) // Engine front upper left setcolour(maprgb(100,140,180)) cdrawtriangle3d( 5_000, 0, 0, 4_500, 0_550, 0_500, 4_500, 0_550, 0) cdrawtriangle3d( 5_000, 0, 0, 4_500,-0_550, 0_500, 4_500,-0_550, 0) // Engine left lower setcolour(maprgb(80,80,60)) cdrawquad3d( 1_033, 1_000, 0, 1_800, 1_000, -2_000, 4_500, 0_550, -1_750, 4_500, 0_550, 0) // Engine right lower setcolour(maprgb(80,100,60)) cdrawquad3d( 1_033,-1_000, 0, 1_800,-1_000, -2_000, 4_500,-0_550, -1_750, 4_500,-0_550, 0) // Engine top left setcolour(maprgb(100,130,60)) cdrawquad3d( 1_033, 0_900, 0_950, 1_033, 0_900, 0_000, 4_500, 0_550, 0_000, 4_500, 0_550, 0_500) // Engine top centre setcolour(maprgb(130,160,90)) cdrawquad3d( 1_033, 0_900, 0_950, 1_033,-0_900, 0_950, 4_500,-0_550, 0_500, 4_500, 0_550, 0_500) // Engine top right setcolour(maprgb(100,130,60)) cdrawquad3d( 1_033,-0_900, 0_950,
1_033,-0_900, 4_500,-0_550, 4_500,-0_550, 0_000, 0_000, 0_500)
213
// Engine bottom setcolour(maprgb(100,80,50)) cdrawquad3d( 4_500, 0_550, -1_750, 4_500,-0_550, -1_750, 1_800,-1_000, -2_000, 1_800, 1_000, -2_000)
// Front cockpit left setcolour(maprgb(120,140,60)) cdrawquad3d( -2_000, 1_000, 0_000, -2_000, 0_870, 0_600, -3_300, 0_870, 0_600, -3_300, 1_000, 0_000) // Front cockpit right setcolour(maprgb(120,140,60)) cdrawquad3d( -2_000,-1_000, 0_000, -2_000,-0_870, 0_600, -3_300,-0_870, 0_600, -3_300,-1_000, 0_000) // Top front left setcolour(maprgb(100,120,40)) cdrawquad3d( 1_033, 0_900, 0_950, -2_000, 0_750, 1_000, -2_000, 0_750, 0_000, 1_033, 0_900, 0_000) // Top front middle setcolour(maprgb(120,140,60)) cdrawquad3d( 1_033, 0_900, 0_950, 1_033,-0_900, 0_950, -2_000,-0_750, 1_000, -2_000, 0_750, 1_000) // Top front right setcolour(maprgb(100,120,40)) cdrawquad3d( 1_033,-0_900, 0_950, -2_000,-0_750, 1_000, -2_000,-0_750, 0_000,
214

1_033,-0_900, 0_000)
// Front wind shield setcolour(maprgb(180,200,150)) cdrawquad3d( -1_300, 0_450, 1_000, -2_000, 0_450, 1_400, -2_000,-0_450, 1_400, -1_300,-0_450, 1_000) setcolour(maprgb(220,220,180)) cdrawtriangle3d( -1_300, 0_450, 1_000, -2_000, 0_450, 1_400, -2_000, 0_650, 1_000) setcolour(maprgb(170,200,150)) cdrawtriangle3d( -1_300,-0_450, -2_000,-0_450, -2_000,-0_650,
1_000, 1_400, 1_000)
// Top left middle setcolour(maprgb(130,160,90)) cdrawquad3d( -3_300, 0_750, 1_000, -3_300, 1_000, 0_000, -4_300, 1_000, 0_000, -4_300, 0_750, 1_000) // Top centre middle setcolour(maprgb(120,140,60)) cdrawquad3d( -3_300, 0_750, 1_000, -3_300,-0_750, 1_000, -4_300,-0_750, 1_000, -4_300, 0_750, 1_000) // Top right middle setcolour(maprgb(130,160,90)) cdrawquad3d( -3_300,-0_750, 1_000, -3_300,-1_000, 0_000, -4_300,-1_000, 0_000, -4_300,-0_750, 1_000) // Rear cockpit left setcolour(maprgb(120,140,60)) cdrawquad3d( -4_300, 1_000, 0_000, -4_300, 0_870, 0_600,
-5_583, 0_870, -5_583, 1_000, 0_600, 0_000)
215
// Rear wind shield setcolour(maprgb(180,200,150)) cdrawquad3d( -3_600, 0_450, 1_000, -4_300, 0_450, 1_400, -4_300,-0_450, 1_400, -3_600,-0_450, 1_000) setcolour(maprgb(220,220,180)) cdrawtriangle3d( -3_600, 0_450, 1_000, -4_300, 0_450, 1_400, -4_300, 0_650, 1_000) setcolour(maprgb(170,200,150)) cdrawtriangle3d( -3_600,-0_450, -4_300,-0_450, -4_300,-0_650,
1_000, 1_400, 1_000)
// Rear cockpit right setcolour(maprgb(110,140,70)) cdrawquad3d( -4_300,-1_000, 0_000, -4_300,-0_870, 0_600, -5_583,-0_870, 0_600, -5_583,-1_000, 0_000)
// Lower left middle setcolour(maprgb(140,110,70)) cdrawquad3d( 1_033, 1_000, 0, 1_800, 1_000, -2_000, -3_583, 1_000, -2_238, -3_583, 1_000, 0) // Bottom middle setcolour(maprgb(120,100,60)) cdrawquad3d( 1_800, 1_000, -2_000, -3_583, 1_000, -2_238, -3_583,-1_000, -2_238, 1_800,-1_000, -2_000) // Lower right middle setcolour(maprgb(140,110,70))
216

1_033,-1_000, 0, 1_800,-1_000, -2_000, -3_583,-1_000, -2_238, -3_583,-1_000, 0)
cdrawquad3d(
// Lower left back setcolour(maprgb(160,120,80)) cdrawquad3d( -3_583, 1_000, 0, -16_000, 0_050, 0, -16_000, 0_050, -0_667, -3_583, 1_000, -2_238) // Bottom back setcolour(maprgb(130,90,60)) cdrawquad3d( -3_583, 1_000, -2_238, -16_000, 0_050, -0_667, -16_000,-0_050, -0_667, -3_583,-1_000, -2_238) // Lower right back setcolour(maprgb(160,140,80)) cdrawquad3d( -3_583,-1_000, 0, -16_000,-0_050, 0, -16_000,-0_050, -0_667, -3_583,-1_000, -2_238) // Top left back setcolour(maprgb(130,130,80)) cdrawtriangle3d( -5_583, 0_650, -5_583, 1_000, -13_900, 0_150,
0_950, 0_000, 0)
// Top centre back setcolour(maprgb(130,160,90)) cdrawquad3d( -5_583, 0_650, 0_950, -5_583,-0_650, 0_950, -13_900,-0_150, 0, -13_900, 0_150, 0) // Top right back setcolour(maprgb(130,130,80)) cdrawtriangle3d( -5_583,-0_650, -5_583,-1_000, -13_900,-0_150,
0_950, 0_000, 0)
217
// Fin { // Rudder deflection 1 inch from hinge LET a = muldiv(1_100, c_rudder, 32_768*17) setcolour(maprgb(170,180,80)) cdrawquad3d(-14_000, 0_000, 0, -16_000, 0_000, 0, -16_000, 0_000, 1_000, -15_200, 0_000, 1_000)
// Fin
setcolour(maprgb(70,120,40)) cdrawquad3d(-15_200-3*a, 9*a, 1_000, -16_000, 0, 1_000, -16_800+3*a,-10*a, 3_100, -16_000, 0, 2_550) setcolour(maprgb(70, 80,40)) cdrawquad3d(-16_000, 0, 1_000, -16_800+3*a,-10*a, 3_100, -17_566+4*a,-14*a, 2_600, -17_816+4*a,-17*a, 1_667) setcolour(maprgb(70,120,40)) cdrawquad3d(-16_000, 0, 1_000, -17_816+4*a,-17*a, 1_667, -17_816+4*a,-17*a, 1_000, -17_566+4*a,-14*a, 0) setcolour(maprgb(70, 80,40)) cdrawquad3d(-16_000, 0, 1_000, -17_566+4*a,-14*a, 0, -17_000+2*a,- 8*a,-0_583, -16_000, 0,-0_667) // Tail skid setcolour(maprgb(20, 20,20)) cdrawquad3d(-16_000, 0, -16_200, 0, -16_500+2*a, -8*a, -16_300+2*a, -7*a, }
// Rudder
-0_667, -0_667, -0_900, -0_900)
// Tailplane and elevator { // Elevator deflection 1 inch from hinge LET a = muldiv(0_600, c_elevator, 32_768*17)
218
setcolour(maprgb(160,200,50)) cdrawquad3d(-16_000, 0_000, -13_900, 0_600, -14_600, 2_800, -16_000, 4_500, setcolour(maprgb(120,200,50)) cdrawtriangle3d(-13_900, 0_600, -13_900,-0_600, -16_000, 0_000, cdrawquad3d(-16_000, 0_000, -13_900,-0_600, -14_600,-2_800, -16_000,-4_500, setcolour(maprgb(170,150,80)) cdrawquad3d(-16_000, 0_000, -17_200+4*a, 0_600, -17_500+5*a, 0_900, -17_666+5*a, 2_000,
0, // Left tailplane 0, 0, 0)
0, 0, 0) 0, // Right tailplane 0, 0, 0)
0, // Left elevator -15*a, // pt 1 -16*a, // pt 2 -17*a) // pt 3
setcolour(maprgb(120,170,60)) cdrawquad3d(-16_000, 0_000, 0, // Left elevator -17_666+5*a, 2_000, -17*a, // pt 3 -17_450+4*a, 3_500, -16*a, // pt 4 -17_200+4*a, 4_650, -14*a) // pt 5 setcolour(maprgb(160,120,40)) cdrawquad3d(-16_000, 0_000, 0, // Left elevator -17_200+4*a, 4_650, -14*a, // pt 5 -16_700+a/2, 4_833, -2*a, // pt 6 -16_000, 4_500, a) // pt 7 setcolour(maprgb(170,150,80)) cdrawquad3d(-16_000, 0_000, -17_200+4*a,-0_600, -17_500+5*a,-0_900, -17_666+5*a,-2_000,
0, -15*a, -16*a, -17*a)
// // // //
Right elevator pt 1 pt 2 pt 3
setcolour(maprgb(120,170,60)) cdrawquad3d(-16_000, 0_000, 0, // Right elevator -17_666+5*a,-2_000, -17*a, // pt 3 -17_450+4*a,-3_500, -16*a, // pt 4
5.13. TIGERMOTH FLIGHT SIMULATOR

-17_200+4*a,-4_650, -14*a) // pt 5 setcolour(maprgb(160,120,40)) cdrawquad3d(-16_000, 0_000, 0, // Right elevator -17_200+4*a,-4_650, -14*a, // pt 5 -16_700+a/2,-4_833, -2*a, // pt 6 -16_000, -4_500, a) // pt 7 } }
219
5.13
Tigermoth Flight Simulator
This section describes a ight simulator for a De Havilland Tiger Moth biplane. A typical image of the ight simulator in use is as follows.
Notice that the USB joystick used has more features than the one shown on page 106. This one is a Cyborg X joystick. It can control the aileron, elevator and rudder. It has two throttle levers which can be locked together. There is an eight direction hat which can be used to change the direction of view of either the pilot or an observer, and there are 12 buttons. It typically costs about 32. More to follow.
/* ########### THIS IS UNDER DEVELOPMENT ###############################
220
This is a flight simulator based on Jumbo that ran interactively on a PDP 11 generating the pilots view on a Vector General Display. Originally implemented by Martin Richards in mid 1970s. Substantially modified my Martin Richards (c) October 2012. It has been extended to use 32 rather than 16 bit arithmetic. It is planned that this will simulate the flying characterists of a De Havilland D.H.82A Tiger Moth which I learnt to fly as a teenager.
Change history 25/01/2013 Name changed to tiger.b Controls Either use a USB Joystick for elevator, ailerons and throttle, or use the keyboard as follows: Up arrow Down arrow Left arrow Right arrow , or < . or > x z Trim Trim Trim Trim Trim Trim Trim Trim joystick joystick joystick joystick forward a bit backward a bit left a bit right a bit
rudder left rudder right more thrust less thrust
0 Display the pilots view 1,2,3,4,5,6,7,8 Display the aircraft viewed from various angles f n p g t View aircraft from a greater distance View aircraft from a closer position pause/unpause the simulation Reset the aircraft on the glide path Reset the aircraft ready for take off -- default ie stationary on the ground at the end of the runway
221
b u t q
brake on/off -- not available undercarriage up/down -- not available testing mode Quit
There are joystick buttons equivalent to Up arrow, Down arrow, Left Arrow and Right arrow. There are also joystick buttons to trim the rudder left and right, useful for streering on the runway. There are also joystick buttons to toggle gear up/down and brakes on/off. The display shows various beacons on the ground including the lights on the sides and the ends of the runway. The display also shows various flight instruments including the artificial horizon, the height and speed and various navigational aids to help the pilot find the runway. */ GET GET GET . GET GET "libhdr" "sdl.h" "sdl.b" "libhdr" "sdl.h"
MANIFEST { D45 = 0_707107 Sps = 10
// // // //
Direction cosines scaling factor ie 6 decimal digits after the decimal point. cosine of pi/4 Steps per second
// Most measurements are in feet scaled with 3 digits after the decimal point k_g = 32_000 // Acceleration due to gravity, 32 ft per sec per sec // Scaled with 3 digits after the decimal point. k_drag = k_g/15 // Acceleration due to drag as 100 ft per sec // The drag is proportional to the square of the speed. // Conversion factors mph2fps = 5280_000/(60*60) mph2knots = 128_000/147 }
222
GLOBAL { aircraft:ug stepping crashed debugging testing plotusage done
// Select which aircraft to simulate // =FALSE if not stepping the simulation // =TRUE if crashed // Toggle testing mode
col_black col_blue col_green col_yellow col_red col_majenta col_cyan col_white col_darkgray col_darkblue col_darkgreen col_darkyellow col_darkred col_darkmajenta col_darkcyan col_gray col_lightgray col_lightblue col_lightgreen col_lightyellow col_lightred col_lightmajenta col_lightcyan c_thrust; c_aileron; c_elevator; c_rudder; c_trimthrust c_trimaileron c_trimelevator c_trimrudder
c_geardown // TRUE or FALSE c_brakeson // TRUE or FALSE ctx; cty; ctz cwx; cwy; cwz clx; cly; clz // Direction cosines of direction t // Direction cosines of direction w // Direction cosines of direction l
223
cetx; cety; cetz // Eye direction cosines of direction t cewx; cewy; cewz // Eye direction cosines of direction w celx; cely; celz // Eye direction cosines of direction l cockpitz cgx; cgy; cgz // Height of the pilots eye // Coordinates of the CG of the aircraft // in feet with 3 digits after the decimal point // eg cgz=1000_000 represents a height of 1000 ft
cgxdot; cgydot; cgzdot // These are set by step() eyex; eyey; eyez // Relative position of the eye eyedist // Eye x or y distance from aircraft hatdir hatmsecs eyedir // // // // // Hat direction msecs of last hat change Eye direction 0 = cockpit view 1,...,8 view from behind, behind-left, etc
cdrawtriangle3d cdrawquad3d // Speed in various directions is measured in ft/s scaled // with 3 digits after the decimal point // eg 146_666 represents 146.666 ft/s = 100 mph tdot; wdot; ldot // Speed in t, w and l directions tdotsq; wdotsq; ldotsq // Speed squared in t, w and l directions mass // Mass of the aircraft
mit; miw; mil // Moment of inertia about t, w and l axes rtdot; rwdot; rldot // Rotation rates about t, w and l axes rdt; rdw; rdl // Rotational damping about t, w and l axes //Linear forces are scaled ft; ft1 // Force and fw; fw1 // Force and fl; fl1 // Force and with 3 digits after previous force in t previous force in w previous force in l the decimal point direction direction direction
// Rotational forces are scaled with 6 digits after the decimal point // as are direction cosines.
224

// Current and previous moment about t axis // Current and previous moment about w axis // Current and previous moment about l axis
rft; rft1 rfw; rfw1 rfl; rfl1
atl; atw; awl // Angle of air flow in planes tl, tw and wl // Table interpolated by rdtab(angle, tab) rtltab; rtwtab; rwltab // Rotational tables tltab; twtab; wltab // Linear tables usage } // Insert the definition of drawtigermoth() GET "drawtigermoth.b" LET inprod(a,b,c, x,y,z) = // Return the cosine of the angle between two unit vectors. muldiv(a, x, One) + muldiv(b, y, One) + muldiv(c, z, One) AND rotate(t, w, l) BE { // Rotate the orientation of the aircraft // t, w and l are assumed to be small and cause // rotation about axis t, w, l. Positive values cause // anti-clockwise rotations about their axes. LET tx = inprod(One, -l, w, ctx,cwx,clx) LET wx = inprod( l,One, -t, ctx,cwx,clx) LET lx = inprod( -w, t,One, ctx,cwx,clx) LET ty = inprod(One, -l, w, cty,cwy,cly) LET wy = inprod( l,One, -t, cty,cwy,cly) LET ly = inprod( -w, t,One, cty,cwy,cly) LET tz = inprod(One, -l, w, ctz,cwz,clz) LET wz = inprod( l,One, -t, ctz,cwz,clz) LET lz = inprod( -w, t,One, ctz,cwz,clz) ctx, cty, ctz := tx, ty, tz cwx, cwy, cwz := wx, wy, wz clx, cly, clz := lx, ly, lz adjustlength(@ctx); adjustlength(@cwx); adjustlength(@clx) adjustortho(@ctx, @cwx); adjustortho(@ctx, @clx); adjustortho(@cwx, @clx) } // 0 to 100 percentage cpu usage
225
AND adjustlength(v) BE { // This helps to keep vector v of unit length LET x, y, z = v!0, v!1, v!2 LET corr = One + (inprod(x,y,z, x,y,z) - One)/2 v!0 := muldiv(x, One, corr) v!1 := muldiv(y, One, corr) v!2 := muldiv(z, One, corr) } AND adjustortho(a, b) BE { // This helps to keep the unit vector b orthogonal to a LET a0, a1, a2 = a!0, a!1, a!2 LET b0, b1, b2 = b!0, b!1, b!2 LET corr = inprod(a0,a1,a2, b0,b1,b2) b!0 := b0 - muldiv(a0, corr, One) b!1 := b1 - muldiv(a1, corr, One) b!2 := b2 - muldiv(a2, corr, One) } AND rdtab(a, tab) = VALOF { // Perform linear interpolation between appropriate entries // in the given table. The first and last entries must be for // angles -180.000 and +180.000, repectively. // The angle a is scaled with three digits after the decimal point. LET p = tab LET a0, r0, a1, r1 = ?, ?, ?, ? IF a<-180_000 DO a := -180_000 IF a>+180_000 DO a := +180_000 WHILE a>!p DO p := p+2 IF a=!p RESULTIS p!1 a0, r0 := p!-2, p!-1 a1, r1 := p! 0, p! 1 RESULTIS r0 + muldiv(r1-r0, a-a0, a1-a0) } AND angle(x, y) = x=0 & y=0 -> 0, VALOF { // Calculate an approximation to the angle in degrees between // point (x,y) and the x axis. The result is a scaled number with // three digits after the decimal point. // Points above the x axis have positive angles and // points below the x axis have negative angles. LET px, py = ABS x, ABS y LET t = muldiv(90_000, y, px+py) IF x>=0 RESULTIS t
226
IF y>=0 RESULTIS 180_000 - t RESULTIS -(180_000 + t) } LET step() BE { // Update the aircraft position, orientation and motion. // Calculate the // In directions ft, fw, fl := rft, rfw, rfl := // Air atl := atw := awl := linear and rotational forces on the aircraft t, w and l 0, 0, 0 // Initialise all to zero 0, 0, 0
flow angles angle(tdot, ldot) angle(tdot, wdot) angle(wdot, ldot)
// Calculate speed squared in the three direction // scaled so that 100 ft/s squared gives 1.000 scaled // with 3 digits after the decimal point. tdotsq := muldiv(tdot, tdot, 10_000_000) wdotsq := muldiv(wdot, wdot, 10_000_000) ldotsq := muldiv(ldot, ldot, 10_000_000) //writef("tdot=%8.3d ldot=%8.3d atl=%7.3d*n", tdot, ldot, atl) //writef("tdot=%8.3d wdot=%8.3d atw=%7.3d*n", tdot, wdot, atw) //writef("wdot=%8.3d ldot=%8.3d awl=%7.3d*n", wdot, ldot, awl) //writef("tdotsq=%8.3d wdotsq=%8.3d ldotsq=%8.3d*n", tdotsq, wdotsq, ldotsq) // Rotational damping // rtdot, rwdot and rldot are in radians per second. rtdot := muldiv(rtdot, rdt, 1_000*Sps) rwdot := muldiv(rwdot, rdw, 1_000*Sps) rldot := muldiv(rldot, rdl, 1_000*Sps) // Rotational aerodynamic forces on fixed surfaces // Dihedral effect rft := rft + muldiv(-10, wdotsq, 100) // Stabiliser effect rfw := rfw + muldiv(-10, ldot, 100) // Fin effect

rfl := rfl + muldiv(-10, wdotsq, 100) // Aileron effect rft := rft + muldiv(-c_aileron, tdot, 200) // Elevator effect rfw := rfw - muldiv(c_elevator, tdot+c_thrust, 100) // Rudder effect rfl := rft + muldiv(c_rudder, tdot+c_thrust, 100) //writef("rft=%9.6d rft1=%9.6d*n", rft, rft1) //writef("rfw=%9.6d rfw1=%9.6d*n", rft, rft1) //writef("rfl=%9.6d rfl1=%9.6d*n", rft, rft1) UNLESS testing DO { // Do not apply rotations in testing mode // Apply rotational effects using the trapizoidal rule // for integration. rtdot := rtdot + (rft+rft1)/2/Sps rwdot := rwdot + (rfw+rfw1)/2/Sps rldot := rldot + (rfl+rfl1)/2/Sps } rft1, rfw1, rfl1 := rft, rfw, rfl // Save previous values // Linear forces // ft fw fl Gravity := ft + := fw + := fl + effect muldiv(-k_g, ctz, One) // Gravity in direction t muldiv(-k_g, cwz, One) // Gravity in direction w muldiv(-k_g, clz, One) // Gravity in direction l
227
// Drag effect ft := ft - muldiv(-k_drag, tdot, 1000000) // Side effect fw := fw - muldiv(wdot, 100, 1000) // Lift effect { // Lift is proportions to speed squared (= tdot**2 + ldot**2) // multiplied by rdtab(angle, tltab) // When angle=0 and speed=100 ft/sec lift is k_g // angle(0, tltab) = 267 // so lift = k_g * (rdtab(angle, tltab)/267) * (speed*speed/(100*100)
228

LET tab = TABLE -180_000, 0, -90_000, 500, -15_000, 200, -11_000, 1000, 0, 267, // Lift factor when ldot=0 4_000, 0, 19_000, -600, 24_000, -100, 90_000, -500, 180_000, 0 LET a = muldiv(k_g, rdtab(atl, tab), 267) fl := fl + muldiv(a, tdotsq+ldotsq, 1000)
} // Thrust effect ft := ft + muldiv(c_thrust, k_g/8, 2*32768) //writef("ft=%9.3d fw=%9.3d fl=%9.3d*n", ft, fw, fl) UNLESS testing DO { // Do not apply the forces in testing mode // Apply linear effects using the trapizoidal rule // for integration. tdot := tdot + (ft+ft1)/2/Sps wdot := wdot + (fw+fw1)/2/Sps ldot := ldot + (fl+fl1)/2/Sps ft1, fw1, fl1 := ft, fw, fl // Save the previous values
// Calculate x, y and z speeds cgxdot := inprod(ctx,cwx,clx, tdot,wdot,ldot) cgydot := inprod(cty,cwy,cly, tdot,wdot,ldot) cgzdot := inprod(ctz,cwz,clz, tdot,wdot,ldot) // Calculate cgx := cgx + cgy := cgy + cgz := cgz + new x, y and z positions. cgxdot/Sps cgydot/Sps cgzdot/Sps
rotate(rtdot/Sps, rwdot/Sps, rldot/Sps) // Compute the new values of tdot, wdot and ldot // from cgxdot, cgydot and cgzdot using the new orientation

tdot := inprod(cgxdot,cgydot,cgzdot, ctx,cty,ctz) wdot := inprod(cgxdot,cgydot,cgzdot, cwx,cwy,cwz) ldot := inprod(cgxdot,cgydot,cgzdot, clx,cly,clz) //writef("cgx=%9.3d cgy=%9.3d cgz=%9.3d*n", cgx, cgy, cgy) //abort(1003) } IF cgz < 10_000 DO { // The aircraft is near the ground IF cgz < 2_000 | clz<0_800000 DO { crashed := TRUE stepping := FALSE RETURN }
229
} } AND plotcraft() BE { IF depthscreen FOR i = 0 TO screenxsize*screenysize-1 DO depthscreen!i := maxint //seteyeposition() IF aircraft=0 DO { // Simple aircraft setcolour(maprgb(64,128,64)) // Fuselage cdrawtriangle3d(6_000,0,0, 2_000,0,-1_000, -2_000,0,2_000) setcolour(maprgb(40,100,40)) cdrawtriangle3d(2_000,0,-1_000, -2_000,0,2_000, -12_000,0,0) setcolour(maprgb(255,255,255)) cdrawtriangle3d(2_000,0, 1_000, -2_000,0,2_000, 0_800,0,2_000) setcolour(maprgb(255,0,0)) // Port wing -- Red cdrawtriangle3d(2_500,0,0, -2_500,0,0, -2_000, 18_000,2_000) setcolour(maprgb(0,255,0)) // Starboard wing -- Green cdrawtriangle3d(2_500,0,0, -2_500,0,0, -2_000,-18_000,2_000) setcolour(maprgb(255,0,255)) // Stabliser cdrawtriangle3d(-9_000,0,0, -12_000,0,0, -13_000,-4_000,0) setcolour(maprgb(255,255,0)) cdrawtriangle3d(-9_000,0,0, -12_000,0,0, -13_000, 4_000,0)
230

setcolour(maprgb(0,255,255)) // Fin cdrawtriangle3d(-9_000,0,0, -12_000,0,0,
-13_000,0,4_000)
} IF aircraft=1 DO { // Draw a Tigermoth //writef("Calling drawtigermoth*n") drawtigermoth() //writef("Returned from drawtigermoth*n") } IF aircraft=2 DO { LET s = 10_000 LET r = 3_000 // top setcolour(maprgb(0,0,0)) cdrawquad3d( r,0,s, 0,r,s,
-r,0,s,
0,-r,s)
// top wings setcolour(maprgb(255,0,0)) cdrawtriangle3d( r, 0, s, s, 0, setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0, r, s, 0, s, setcolour(maprgb(255,0,0)) cdrawtriangle3d(-r, 0, s, -s, 0, setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0,-r, s, 0,-s, // Sides setcolour(maprgb(128,0,0)) cdrawquad3d(s,0,r, s,r,0,
s, s,
s, 0, r) // N 0, s, r) // W
s, -s, 0, r) // S s, 0,-s, r) // E
s,0,-r,
s,-r,0)
// N
setcolour(maprgb(255,128,0)) cdrawquad3d(0,s,r, r,s,0, 0,s,-r, setcolour(maprgb(255,0,128)) cdrawquad3d(-s,0,r, -s,r,0,
-r,s,0)
// W
-s,0,-r,
-s,-r,0) // S
setcolour(maprgb(255,128,128)) cdrawquad3d(0,-s,r, r,-s,0, 0,-s,-r, // Centre wings setcolour(maprgb(255,128,0)) cdrawtriangle3d( s, s, 0, r, s, 0,
-r,-s,0) // W
s, r, 0) // NW

setcolour(maprgb(0,255,128)) cdrawtriangle3d(-s, s, 0, -s, r, 0, -r, s, 0) // SW setcolour(maprgb(128,0,255)) cdrawtriangle3d(-s,-s, 0, -r,-s, 0, -s,-r, 0) // SE setcolour(maprgb(127,255,255)) cdrawtriangle3d( s,-s, 0, s,-r, 0, r,-s, 0) // NE // bottom wings setcolour(maprgb(255,0,0)) cdrawtriangle3d( r, 0,-s, s, 0,-s, s, 0,-r) setcolour(maprgb(0,255,0)) cdrawtriangle3d( 0, r,-s, 0, s,-s, 0, s,-r) setcolour(maprgb(255,0,255)) cdrawtriangle3d(-r, 0,-s, -s, 0,-s, -s, 0,-r) setcolour(maprgb(0,255,255)) cdrawtriangle3d( 0,-r,-s, 0,-s,-s, 0,-s,-r) // Bottom setcolour(maprgb(128,128,128)) cdrawquad3d( r,0,-s, 0,r,-s, -r,0,-s, } } AND gdrawquad3d(x1,y1,z1, x2,y2,z2, x3,y3,z3, x4,y4,z4) BE { // Draw a 3D quad (not rotated) LET sx1,sy1,sz1 = ?,?,? LET sx2,sy2,sz2 = ?,?,? LET sx3,sy3,sz3 = ?,?,? LET sx4,sy4,sz4 = ?,?,? UNLESS UNLESS UNLESS UNLESS screencoords(x1-eyex, screencoords(x2-eyex, screencoords(x3-eyex, screencoords(x4-eyex, y1-eyey, y2-eyey, y3-eyey, y4-eyey, z1-eyez, z2-eyez, z3-eyez, z4-eyez, @sx1) @sx2) @sx3) @sx4) RETURN RETURN RETURN RETURN
231
// N // W // S // E
0,-r,-s)
//drawquad3d(sx1,sy1,sz1, sx2,sy2,sz2, sx3,sy3,sz3, sx4,sy4,sz4) } AND cdrawquad3d(x1,y1,z1, x2,y2,z2, x3,y3,z3, x4,y4,z4) BE { LET rx1 = inprod(x1,y1,z1, ctx,cwx,clx) LET ry1 = inprod(x1,y1,z1, cty,cwy,cly) LET rz1 = inprod(x1,y1,z1, ctz,cwz,clz) LET rx2 = inprod(x2,y2,z2, ctx,cwx,clx) LET ry2 = inprod(x2,y2,z2, cty,cwy,cly)
232
LET rz2 = inprod(x2,y2,z2, ctz,cwz,clz) LET rx3 = inprod(x3,y3,z3, ctx,cwx,clx) LET ry3 = inprod(x3,y3,z3, cty,cwy,cly) LET rz3 = inprod(x3,y3,z3, ctz,cwz,clz) LET rx4 = inprod(x4,y4,z4, ctx,cwx,clx) LET ry4 = inprod(x4,y4,z4, cty,cwy,cly) LET rz4 = inprod(x4,y4,z4, ctz,cwz,clz) LET sx1,sy1,sz1 = ?,?,? LET sx2,sy2,sz2 = ?,?,? LET sx3,sy3,sz3 = ?,?,? LET sx4,sy4,sz4 = ?,?,? //writef("cdrawquad3d called*n") UNLESS screencoords(rx1-eyex, ry1-eyey, rz1-eyez, UNLESS screencoords(rx2-eyex, ry2-eyey, rz2-eyez, UNLESS screencoords(rx3-eyex, ry3-eyey, rz3-eyez, UNLESS screencoords(rx4-eyex, ry4-eyey, rz4-eyez, //writef("calling drawquad3d*n") //writef("sx1=%i5 sy1=%i5 sz1=%i5*n", sx1,sy1,sz1) //writef("sx2=%i5 sy2=%i5 sz2=%i5*n", sx2,sy2,sz2) //writef("sx3=%i5 sy3=%i5 sz3=%i5*n", sx3,sy3,sz3) //writef("sx4=%i5 sy4=%i5 sz4=%i5*n", sx4,sy4,sz4) drawquad3d(sx1,sy1,sz1, sx2,sy2,sz2, sx3,sy3,sz3, //writef("returned from drawquad3d*n") } AND cdrawtriangle3d(x1,y1,z1, x2,y2,z2, x3,y3,z3) BE { LET rx1 = inprod(x1,y1,z1, ctx,cwx,clx) LET ry1 = inprod(x1,y1,z1, cty,cwy,cly) LET rz1 = inprod(x1,y1,z1, ctz,cwz,clz) LET rx2 = inprod(x2,y2,z2, ctx,cwx,clx) LET ry2 = inprod(x2,y2,z2, cty,cwy,cly) LET rz2 = inprod(x2,y2,z2, ctz,cwz,clz) LET rx3 = inprod(x3,y3,z3, ctx,cwx,clx) LET ry3 = inprod(x3,y3,z3, cty,cwy,cly) LET rz3 = inprod(x3,y3,z3, ctz,cwz,clz) LET sx1,sy1,sz1 = ?,?,? LET sx2,sy2,sz2 = ?,?,? LET sx3,sy3,sz3 = ?,?,?
@sx1) @sx2) @sx3) @sx4)
RETURN RETURN RETURN RETURN
sx4,sy4,sz4)

UNLESS screencoords(rx1-eyex, ry1-eyey, rz1-eyez, @sx1) RETURN UNLESS screencoords(rx2-eyex, ry2-eyey, rz2-eyez, @sx2) RETURN UNLESS screencoords(rx3-eyex, ry3-eyey, rz3-eyez, @sx3) RETURN drawtriangle3d(sx1,sy1,sz1, sx2,sy2,sz2, sx3,sy3,sz3) }
233
AND screencoords(x,y,z, v) = VALOF { // If the point (x,y,z) is in view, set v!0, v!1 and v!2 to // the screen coordinates and depth and return TRUE // otherwise return FALSE LET sx = inprod(x,y,z, cewx,cewy,cewz) // Horizontal LET sy = inprod(x,y,z, celx,cely,celz) // Vertical LET sz = inprod(x,y,z, cetx,cety,cetz) // Depth LET screensize = screenxsize>=screenysize -> screenxsize, screenysize //writef("screencoords: x=%9.3d y=%9.3d z=%9.3d*n", x,y,z) //writef("cetx=%9.6d cety=%9.6d cetz=%9.6d*n", cetx,cety,cetz) //writef("cewx=%9.6d cewy=%9.6d cewz=%9.6d*n", cewx,cewy,cewz) //writef("celx=%9.6d cely=%9.6d celz=%9.6d*n", celx,cely,celz) //writef("eyex=%9.3d eyey=%9.3d eyez=%9.3d*n", eyex,eyey,eyez) // Test that the point is in view, ie at least 1.000ft in front // and no more than about 27 degrees (inverse tan 1/2) from the // direction of view. IF sz<1_000 & muldiv(sz, sz, 2000) >= muldiv(sx, sx, 1000) + muldiv(sy, sy, 1000) RESULTIS FALSE // A point screensize pixels away from the centre of the screen is // 45 degrees from the direction of view. // Note that many pixels in this range are off the screen. v!0 := -muldiv(sx, screensize, sz)/1 + screenxsize/2 v!1 := +muldiv(sy, screensize, sz)/1 + screenysize/2 v!2 := sz // This distance into the screen in arbitrary units, used // for hidden surface removal. //writef("in view //abort(1119) RESULTIS TRUE } position=(x=%i4 y=%i4 depth=%n)*n", v!0, v!1, sz)
AND screencoords2(px, py, pz, v) = VALOF { // If the point (px,py,pz) is in the pilots field of view // set v!0 and v!1 to the screen coordinates and return TRUE // otherwise return FALSE
234
//writef("px=%9.3d py=%9.3d pz=%9.3d*n", px, py, pz) //writef("v_t!0=%9.6d v_t!1=%9.6d v_t!2=%9.6d*n", v_t!0, v_t!1, v_t!2) //writef("v_w!0=%9.6d v_w!1=%9.6d v_w!2=%9.6d*n", v_w!0, v_w!1, v_w!2) //writef("v_l!0=%9.6d v_l!1=%9.6d v_l!2=%9.6d*n", v_l!0, v_l!1, v_l!2) LET x = inprod(px,py,pz, cewx,cewy,cewz) LET y = inprod(px,py,pz, celx,cely,celz) LET z = inprod(px,py,pz, cetx,cety,cetz) //writef("x=%9.3d y=%9.3d z=%9.3d*n", x, y, z) // Test that the point is in front of the aircraft // and no more than 45 degrees from the direction of thrust. UNLESS z>20 & muldiv(z, z, 2000) > muldiv(x, x, 1000) + muldiv(y, y, 1000) DO { //abort(1001) RESULTIS FALSE } v!0 := -muldiv(x, screenxsize, z) / 1 + screenxsize/2 v!1 := +muldiv(y, screenxsize, z) / 1 + screenysize/2 //writef("v!0=%4i v!1=%4i*n", v!0, v!1) RESULTIS TRUE } AND draw_artificial_horizon() BE { LET lx, ly, lz = ?, ?, ? LET rx, ry, rz = ?, ?, ? LET x, y, z = ctx, cty, ctz setcolour(col_cyan) screencoords(cgxdot, cgydot, cgzdot, @lx) drawcircle(lx, ly, 5) IF screencoords(x-y/4, y+x/4, 0, @lx) & screencoords(x+y/4, y-x/4, 0, @rx) DO { moveto(lx, ly) drawto(rx, ry) } } AND draw_ground_point(x, y) BE { LET gx, gy, gz = ?, ?, ? //newline() //writef("draw_ground_point: x=%n y=%n*n", x, y) //writef("draw_ground_point: cgx=%n cgy=%n cgz=%n*n", cgx, cgy, cgz) IF screencoords(x-cgx, y-cgy, -cgz-cockpitz, @gx) DO { drawrect(gx, gy, gx+1, gy+1) //updatescreen()

} } AND drawgroundpoints() BE { FOR x = 0 TO 200_000 BY 20_000 DO { FOR y = -50_000 TO 45_000 BY 5_000 DO { LET r = ABS(3*x + 5*y) MOD 23 setcolour(maprgb(30+r,30+r,30+r)) gdrawquad3d(x, y, 0, x+20_000, y, 0, x+20_000, y+5_000, 0, x, y+5_000, 0) } }
235
setcolour(col_white) draw_ground_point( 0, 0) FOR x = 0 TO 3000_000 BY 100_000 DO { draw_ground_point(x, -50_000) draw_ground_point(x, +50_000) } draw_ground_point(3000_000, 0) FOR k = 1000_000 TO 10000_000 BY 1000_000 DO { setcolour(col_lightmajenta) IF k>3000_000 DO draw_ground_point( k, 0) setcolour(col_white) draw_ground_point(-k, 0) setcolour(col_red) draw_ground_point( 0, k) setcolour(col_green) draw_ground_point( 0, -k) } } AND initposition(n) BE SWITCHON n INTO { DEFAULT: CASE 1: // Take off position cgx, cgy, cgz := 100_000,
0, 0
100_000
//
tdot, wdot, ldot := 0, 0, rtdot, rwdot, rldot := 0, 0, 0
// Stationary
236
ctx, cty, ctz := One, 0, 0 cwx, cwy, cwz := 0, One, 0 clx, cly, clz := 0, 0, One
// Direction cosines with // six decimal digits // after to decimal point.
ft1, fw1, fl1 := 0, 0, 0 // Previous linear forces rft1, rfw1, rfl1 := 0, 0, 0 // Previous rotational forces stepping := TRUE crashed := FALSE RETURN CASE 2: // Position on the glide slope cgx, cgy, cgz := -4000_000, 0, 1000_000 tdot, wdot, ldot := 100_000, rtdot, rwdot, rldot := 0, 0, 0 ctx, cty, ctz := One, 0, 0 cwx, cwy, cwz := 0, One, 0 clx, cly, clz := 0, 0, One 0, 0
// height of 1000 ft // 100 ft/s in direction x
// Direction cosines with // six decimal digits // after to decimal point.
ft1, fw1, fl1 := 0, 0, 0 // Previous linear forces rft1, rfw1, rfl1 := 0, 0, 0 // Previous rotational forces stepping := TRUE crashed := FALSE RETURN } LET start() = VALOF { initposition(1) // Get ready for take off done := FALSE cetx, cety, cetz := ctx, cty, ctz cewx, cewy, cewz := cwx, cwy, cwz celx, cely, celz := clx, cly, clz eyex, eyey, eyez := //hatdir, hatmsecs, hatdir, hatmsecs := eyedir := 1 eyedist := 120_000 0, 0, 0 // Relative eye position eyedir := 0, 0, 0 #b0001, 0 // From behind // Eye x or y distance from aircraft
237
cockpitz := 6_000
// Cockpit 8 feet above the ground
c_thrust, c_elevator, c_aileron, c_rudder := 0, 0, 0, 0 c_trimthrust, c_trimelevator, c_trimaileron, c_trimrudder := 0, 0, 0, 0 // Set rotational damping parameters rdt, rdw, rdl := 500, 500, 950 ft, fw, fl := 0, ft1, fw1, fl1 := 0, rft, rfw, rfl := 0, rft1, rfw1, rfl1 := 0, rtdot, rwdot, rldot := 0, //writef("%i7 %i7 %i7*n", usage := 0 testing := FALSE initsdl() mkscreen("Tiger Moth", 800, 600) // Declare a few colours in the pixel format of the screen col_black := maprgb( 0, 0, 0) col_blue := maprgb( 0, 0, 255) col_green := maprgb( 0, 255, 0) col_yellow := maprgb( 0, 255, 255) col_red := maprgb(255, 0, 0) col_majenta := maprgb(255, 0, 255) col_cyan := maprgb(255, 255, 0) col_white := maprgb(255, 255, 255) col_darkgray := maprgb( 64, 64, 64) col_darkblue := maprgb( 0, 0, 64) col_darkgreen := maprgb( 0, 64, 0) col_darkyellow := maprgb( 0, 64, 64) col_darkred := maprgb( 64, 0, 0) col_darkmajenta := maprgb( 64, 0, 64) col_darkcyan := maprgb( 64, 64, 0) col_gray := maprgb(128, 128, 128) col_lightblue := maprgb(128, 128, 255) col_lightgreen := maprgb(128, 255, 128) col_lightyellow := maprgb(128, 255, 255) col_lightred := maprgb(255, 128, 128) col_lightmajenta:= maprgb(255, 128, 255) col_lightcyan := maprgb(255, 255, 128) 0, 0 0, 0 0, 0 0, 0 0, 0 cgx/1000,
cgy/1000, cgz/1000)
238
plotscreen() done := FALSE debugging := FALSE plotusage := FALSE IF FALSE DO { // Test rdtab FOR a = -180_000 TO 180_000 BY 1000 DO { LET t = TABLE -180_000,0, 0,360, 180_000,0 IF a MOD 6_000 = 0 DO writef("*n%i4:", a/1000) writef(" %8.3d", rdtab(a, tltab)) } newline() abort(1009) } IF FALSE DO { // The the angle function writef("x=%i5 y=%i5 angle=%9.3d*n", 1000, 1000, writef("x=%i5 y=%i5 angle=%9.3d*n", 0, 1000, writef("x=%i5 y=%i5 angle=%9.3d*n",-1000, 1000, writef("x=%i5 y=%i5 angle=%9.3d*n",-1000,-1000, writef("x=%i5 y=%i5 angle=%9.3d*n", 1000,-1000, writef("x=%i5 y=%i5 angle=%9.3d*n",-1000, 0, writef("x=%i5 y=%i5 angle=%9.3d*n", 60, 1, writef("x=%i5 y=%i5 angle=%9.3d*n", 60, -1, writef("x=%i5 writef("x=%i5 abort(1009) } aircraft := 1 // The default aircraft -- the tiger moth //aircraft := 0 // The default aircraft -- the dart done := FALSE UNTIL done DO { // Read joystick and keyboard events LET t0 = sdlmsecs() LET t1 = ? //writef("Calling processevents*n") processevents() y=%i5 y=%i5 angle=%9.3d*n",-1000, angle=%9.3d*n",-1000,
angle(1000, 1000)) angle( 0, 1000)) angle(-1000, 1000)) angle(-1000,-1000)) angle( 1000,-1000)) angle(-1000, 0)) angle( 60, 1)) angle( 60, -1)) 1)) -1))
1, angle(-1000, -1, angle(-1000,
239
IF stepping DO step() //writef("x=%9.3d y=%9.3d h=%9.3d tdot=%9.3d*n", cgx, cgy, cgz, tdot) plotscreen() //writef("Calling updatescreen*n") updatescreen() t1 := sdlmsecs() //writef("time %9.3d %9.3d %9.3d %9.3d*n", t0, t1, t1-t0, t0+100-t1) usage := 100*(t1-t0)/100 //IF t0+100 < t1 DO //sdldelay(t0+100-t1) sdldelay(100) //sdldelay(900) //abort(1111) } writef("*nQuitting*n") sdldelay(1_000) closesdl() RESULTIS 0 } AND plotscreen() BE { LET mx = screenxsize/2 LET my = screenysize - 70 seteyeposition() fillscreen(col_blue) setcolour(col_lightcyan) //writef("done=%n*n", done) drawstring(240, 50, done -> "Quitting", "Tiger Moth Flight Simulator") setcolour(col_gray) moveto(mx, my) drawby(0, cgz/100_000) setcolour(col_darkgray) drawfillrect(screenxsize-20-100, screenysize-20-100, screenxsize-20, screenysize-20)
240

screenysize-20-100, screenysize-20) screenysize-50-100, screenysize-30-100)
drawfillrect(screenxsize-50-100, screenxsize-30-100, drawfillrect(screenxsize-20-100, screenxsize-20, IF crashed DO { setcolour(col_red) plotf(mx-50, my+10, "CRASHED") } setcolour(col_red) moveto(mx, my) drawby(cgx/100_000, cgy/100_000)
{ LET pos = muldiv(40, c_thrust, 32768) setcolour(col_red) drawfillrect(screenxsize-45-100, pos+screenysize-15-100, screenxsize-35-100, pos+screenysize- 5-100) } { LET pos = muldiv(45, c_rudder, 32768) setcolour(col_red) drawfillrect(pos+screenxsize-25-50, -5+screenysize-40-100, pos+screenxsize-15-50, +5+screenysize-40-100) } { LET posx = muldiv(45, c_aileron, 32768) LET posy = muldiv(45, c_elevator, 32768) setcolour(col_red) drawfillrect(posx+screenxsize-25-50, posy+screenysize-25-50, posx+screenxsize-15-50, posy+screenysize-15-50) } setcolour(col_majenta) moveto(mx+200, my) drawby(ctx/20_000, cty/20_000)
setcolour(col_lightblue) IF debugging DO { plotf(20, my,
"Thrust=%6i Elevator=%6i Aileron=%6i Rudder=%6i", c_thrust, c_elevator, c_aileron, c_rudder) plotf(20, my- 15, "x=%9.3d y=%9.3d z=%9.3d", cgx, cgy, cgz) plotf(20, my- 30, "tdot=%9.3d wdot=%9.3d ldot=%9.3d", tdot, wdot, ldot)

plotf(20, plotf(20, plotf(20, plotf(20, plotf(20, plotf(20, } IF plotusage DO { plotf(20, my-135, "CPU usage = %3i%%", usage) } draw_artificial_horizon() drawgroundpoints() IF eyedir DO plotcraft() updatescreen() } AND seteyeposition() BE { cetx, cety, cetz := One, 0, 0 cewx, cewy, cewz := 0, One, 0 celx, cely, celz := 0, 0, One // Set eye position relative to CG of the aircraft eyex, eyey, eyez := -eyedist, 0, 0 } AND seteyeposition1() BE { LET d1 = eyedist LET d2 = d1*707/1000 LET d3 = d2/3 cetx, cety, cetz := One, 0, 0 cewx, cewy, cewz := 0, One, 0 celx, cely, celz := 0, 0, One // Set eye position relative to CG of the aircraft eyex, eyey, eyez := -eyedist, 0, 0 // Relative eye position my- 45, my- 60, my- 75, my- 90, my-105, my-120,
241
"atl=%9.3d atw=%9.3d awl=%9.3d", atl, atw, awl) "ct %9.6d %9.6d %9.6d", ctx,cty,ctz) "cw %9.6d %9.6d %9.6d", cwx,cwy,cwz) "cl %9.6d %9.6d %9.6d", clx,cly,clz) "ft =%8.3d fw =%8.3d fl =%8.3d", ft, fw, fl) "rft =%9.6d rfw=%9.6d rfl=%9.6d", rft,rfw,rfl)
UNLESS 0<=eyedir<=8 DO eyedir := 1 IF hatdir & sdlmsecs()>hatmsecs+100 DO { eyedir := ((angle(ctx, cty)+360_000+22_500) / 45_000) & 7 // dir = 0 heading N // dir = 1 heading NE
242

// dir = 2 heading E // dir = 3 heading SE // dir = 4 heading S // dir = 5 heading SW // dir = 6 heading W // dir = 7 heading NW SWITCHON hatdir INTO { DEFAULT: CASE #b0001: CASE #b0011: eyedir := CASE #b0010: eyedir := CASE #b0110: eyedir := CASE #b0100: eyedir := CASE #b1100: eyedir := CASE #b1000: eyedir := CASE #b1001: eyedir := } eyedir := (eyedir & 7) + hatdir := 0
eyedir+1; eyedir+2; eyedir+3; eyedir+4; eyedir+5; eyedir+6; eyedir+7; 1
ENDCASE ENDCASE ENDCASE ENDCASE ENDCASE ENDCASE ENDCASE ENDCASE
// // // // // // // //
Forward Forward right Right Backward right Backward Backward left Left Forward left
writef("ctx=%9.6d cty=%9.6d eyedir=%n //abort(1009) } SWITCHON eyedir INTO { DEFAULT: CASE 0: // Pilots cetx, cety, cetz cewx, cewy, cewz celx, cely, celz eyex, eyey, eyez RETURN view := ctx, cty, := cwx, cwy, := clx, cly, := 0, 0, 0
eyedist=%9.3d*n", ctx, cty, eyedir, eyedist)
ctz cwz clz // Relative eye position
CASE 1: // North cetx, cety, cetz cewx, cewy, cewz celx, cely, celz eyex, eyey, eyez RETURN CASE 2: cetx, cewx, celx,
:= := := :=
One, 0, 0 0, One, 0 0, 0, One -d1, 0, d3
// North east cety, cetz := D45, D45, 0 cewy, cewz := -D45, D45, 0 cely, celz := 0, 0, One

eyex, eyey, eyez := RETURN CASE 3: // East cetx, cety, cetz cewx, cewy, cewz celx, cely, celz eyex, eyey, eyez RETURN -d2, -d2, d3 // Relative eye position
243
:= 0, One, 0 := -One, 0, 0 := 0, 0, One := 0, -d1, d3
CASE 4: // South east cetx, cety, cetz := -D45, D45, 0 cewx, cewy, cewz := -D45,-D45, 0 celx, cely, celz := 0, 0, One eyex, eyey, eyez := d2, -d2, d3 RETURN CASE 5: // South cetx, cety, cetz cewx, cewy, cewz celx, cely, celz eyex, eyey, eyez RETURN
:= -One, 0, 0 := 0, -One, 0 := 0, 0, One := d1, 0, d3
CASE 6: // South west cetx, cety, cetz :=-D45,-D45, 0 cewx, cewy, cewz := D45,-D45, 0 celx, cely, celz := 0, 0, One eyex, eyey, eyez := d2, d2, d3 RETURN CASE 7: // West cetx, cety, cetz cewx, cewy, cewz celx, cely, celz eyex, eyey, eyez RETURN
:= 0,-One, 0 := One, 0, 0 := 0, 0, One := 0, d1, d3
CASE 8: // North west cetx, cety, cetz := D45,-D45, 0 cewx, cewy, cewz := D45, D45, 0 celx, cely, celz := 0, 0, One eyex, eyey, eyez := -d2, d2, d3 RETURN }
244
}
AND processevents() BE WHILE getevent() SWITCHON eventtype INTO { DEFAULT: //writef("Unknown event type = %n*n", eventtype) LOOP CASE sdle_keydown: SWITCHON capitalch(eventa2) INTO { DEFAULT: CASE Q: CASE D: CASE T: CASE U: done := TRUE; debugging := ~debugging; testing := ~testing; plotusage := ~plotusage;
LOOP LOOP LOOP LOOP LOOP
CASE G: // Position aircraft on the glide path initposition(2) LOOP CASE L: // Position the aircraft ready for take off initposition(1) LOOP CASE N: // Reduce eye distance eyedist := eyedist*5/6 IF eyedist<60_000 DO eyedist := 60_000 LOOP CASE F: // Increase eye distance eyedist := eyedist*6/5 LOOP CASE S: aircraft := (aircraft+1) MOD 3;
LOOP
CASE Z: c_trimthrust := c_trimthrust - 500 c_thrust := c_thrust-500; LOOP CASE X: c_trimthrust := c_trimthrust + 500 c_thrust := c_thrust+500; LOOP CASE ,: CASE <: c_trimrudder := c_trimrudder - 500 c_rudder := c_rudder - 500; LOOP
245
CASE .: CASE >: c_trimrudder := c_trimrudder + 500 c_rudder := c_rudder + 500; LOOP CASE CASE CASE CASE CASE CASE CASE CASE CASE 0: 1: 2: 3: 4: 5: 6: 7: 8: eyedir, hatdir, hatdir, hatdir, hatdir, hatdir, hatdir, hatdir, hatdir, hatdir := 0, 0; hatmsecs := #b0001, hatmsecs := #b0011, hatmsecs := #b0010, hatmsecs := #b0110, hatmsecs := #b0100, hatmsecs := #b1100, hatmsecs := #b1000, hatmsecs := #b1001, LOOP LOOP LOOP LOOP LOOP LOOP LOOP LOOP LOOP // // // // // // // // // Pilots view From behind From behind right From right From in front right From in front From in front left From left From behind left
0; 0; 0; 0; 0; 0; 0; 0;
CASE sdle_arrowup:
c_trimelevator := c_trimelevator+500 c_elevator := c_elevator+500; CASE sdle_arrowdown: c_trimelevator := c_trimelevator-500 c_elevator := c_elevator-500; CASE sdle_arrowright: c_trimaileron := c_trimaileron +500 c_aileron := c_aileron+500; CASE sdle_arrowleft: c_trimaileron := c_trimaileron -500 c_aileron := c_aileron-500; } LOOP CASE sdle_joyaxismotion: // 7 { LET which = eventa1 LET axis = eventa2 LET value = eventa3 //writef("axismotion: which=%n axis=%n value=%n*n", which, axis, SWITCHON axis INTO { DEFAULT: LOOP CASE 0: c_aileron := c_trimaileron+value; LOOP // CASE 1: c_elevator := c_trimaileron-value; LOOP // CASE 2: c_thrust := c_trimthrust-value+32768; LOOP // CASE 3: c_rudder := c_trimrudder+value; LOOP // CASE 4: LOOP // } } CASE sdle_joyhatmotion: { LET which = eventa1 LET axis = eventa2 LET value = eventa3
LOOP LOOP LOOP LOOP
value)
Aileron Elevator Throttle Rudder Right throttle
246
//writef("joyhatmotion %n %n %n*n", eventa1, eventa2, eventa3) SWITCHON value INTO { DEFAULT: CASE #b0000: // None CASE #b0001: // North CASE #b0011: // North east CASE #b0010: // East CASE #b0110: // South east CASE #b0100: // South CASE #b1100: // South west CASE #b1000: // West CASE #b1001: // North west IF value>hatdir DO { hatdir, hatmsecs := value, sdlmsecs() //writef("hatdir=%b4 %n msecs*n", hatdir, hatmsecs) } LOOP } }
LOOP
CASE sdle_joybuttondown: // 10 //writef("joybuttondown %n %n %n*n", eventa1, eventa2, eventa3) SWITCHON eventa2 INTO { DEFAULT: LOOP CASE 7: // Left rudder trim c_trimrudder := c_trimrudder - 500 c_rudder := c_rudder - 500; LOOP CASE 8: // Right rudder trim c_trimrudder := c_trimrudder + 500 c_rudder := c_rudder + 500; LOOP CASE 11: // Reduce eye distance eyedist := eyedist*5/6 IF eyedist<400_000 DO eyedist := 400_000 //writef("eyedist=%9.3d*n", eyedist) LOOP CASE 12: // Increase eye distance eyedist := eyedist*6/5 //writef("eyedist=%9.3d*n", eyedist) LOOP CASE 13: // Set pilot view eyedir, hatdir := 0, 0; LOOP } LOOP
247
CASE sdle_joybuttonup: // 11 //writef("joybuttonup*n", eventa1, eventa2, eventa3) LOOP CASE sdle_quit: writef("QUIT*n"); LOOP // 12
CASE sdle_videoresize: // 14 //writef("videoresize*n", eventa1, eventa2, eventa3) LOOP }
248
Appendix A sdl.h
This appendix give the source of the SDL header le cintcode/g/sdl.h. It is mainly here so I can proof read it on my iPad.
/* ######## UNDER DEVELOPMENT ################ This is the header file for the SDL features Implemented by Martin Richards (c) Sept 2012 History: 12/12/12 Added drawtriangle(3d) and drawquad(3d) 28/08/12 Started a major modification of the library. 30/05/12 Initial implementation
g_sdlbase is set in libhdr to be the first global used in the sdl library It can be overridden by re-defining g_sdlbase after GETting libhdr. A program wishing to use the SDL library should contain the following lines. GET "libhdr" MANIFEST { g_sdlbase=nnn GET "sdl.h" GET "sdl.b" .
} // Only used if the default setting of 450 in // libhdr is not suitable. // Insert the library source code
249
250
GET "libhdr" MANIFEST { g_sdlbase=nnn GET "sdl.h" Rest of the program */ GLOBAL { // More functions will be included in due course initsdl: g_sdlbase mkscreen // (title, xsize, ysize) setcaption // (title) closesdl // () screen format lefts leftds rights rightds depthscreen
APPENDIX A. SDL.H
} // Only used if the default setting of 450 in // libhdr is not suitable.
// Handle to the screen surface // Handle to the screen format, used by eg setcolour // // // // // // Used by Used by Used by Used by Used by holding drawtriangle and drawquad drawtriangle3d and drawquad3d drawtriangle and drawquad drawtriangle3d and drawquad3d drawtriangle3d and drawquad3d the depth of a drawn pixel
miny maxy joystick screenxsize screenysize colour maprgb resizescreen setcolour currx curry currz prevdrawn mousex mousey
// Used by drawtriangle(3d) and drawquad(3d) // Used by drawtriangle(3d) and drawquad(3d)
// Current colour for screen // (r, g, b) create colour for current screen format // (xsize, ysize) // (colour) sets colour // Coords of latest point drawn, possibly off screen
// = TRUE if actually drawn // Mouse state set by getmousestate
251
mousebuttons eventtype eventa1 eventa2 eventa3 eventa4 eventa5 mksurface freesurface selectsurface currsurf currxsize currysize setcolourkey drawpoint drawpoint3d moveto moveby drawto drawby moveto3d moveby3d drawto3d drawby3d drawquad drawtriangle setlims drawquad3d drawtriangle3d setlims3d drawstring drawcircle drawrect drawellipse drawfillellipse drawroundrect drawfillroundrect drawfillcircle drawfillrect // Event type set by getevent()
// // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // //
(width, height, key) (surf) (surf, xsize, ysize) Currently selected surface for drawing its width its height (col) (x, y) equivalent to drawfillrect(x,y,1,1) (x, y, z) (x, y) set (currx, curry) to (x,y) (dx, dy) set (currx, curry) to (currx+dx, curry+dy) (x, y) in colour from (currx, curry) to (x,y) (dx, dy) in colour from (currx, curry) to (currx+dxx,curry+dy) (x,y,z) set (currx,curry,currz) to (x,y,z) (dx,dy,dz) set (currx,curry,currz) to (currx+dx,curry+dy,curry+dz) (x,y,z) draw (currx,curry,currz) to (x,y,z) (dx,dy,dz) draw (currx,curry,currz) to (currx+dx,curry+dy) (x1,y1,x2,y2,x3,y3,x4,y4) draw a filled quadraleral (x1,y1,x2,y2,x3,y3) draw a filled triangle used by drawtriangle and drawquad (sets lefts and rights) (x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4) draw a filled 3D quadraleral (x1,y1,z1,x2,y2,z2,x3,y3,z3) draw a filled 3D triangle used by drawtriangle3d and drawquad3d (sets lefts, rights, leftds, (str) (ox, oy, r) (x,y,w,h) (ox, oy, rx, (ox, oy, rx, (x,y,w,h,r) (x,y,w,h,r) (ox, oy, r) (x,y,w,h)
ry) ry) rect with rounded corners rect with rounded corners
252
APPENDIX A. SDL.H
fillsurf movesurf
// (surf) // (surf, dx, dy) move entire surface filling vacated pixels with colour // eg movesurf(screen, -1, 0) move the screen left by one pixel // (src, dsr, x, y) // (src, sx, sy, sw, sh, dsr, dx, dy) // set (mousex, mousey, buttons) // sets event state // (msecs) // () // () // () // () using the SDL delay mechanism returns msecs since start of run
blitsurf blitsurfrect getmousestate getevent sdldelay sdlmsecs hidecursor showcursor updatescreen plotf plotfstr }
display the current screen
// (x, y, format, args...) // Used by plotf
MANIFEST { // ops used in calls of the form: sys(Sys_sdl, op,...) // These should work when using a properly configured BCPL Cintcode system // running under Linux, Windows or or OSX provided the SDL libraries have been // installed. sdl_avail=0 sdl_init // initialise SDL with everything sdl_setvideomode // width, height, bbp, flags sdl_quit // Shut down SDL sdl_locksurface // surf sdl_unlocksurface // surf sdl_getsurfaceinfo // surf, and a pointer to [flag, format, w, h, pitch, pixels] sdl_getfmtinfo // fmt, and a pointer to [palette, bitspp, bytespp, // rloss, rshift, gloss, gshift, bloss, bshift, aloss, ashift, // colorkey, alpha] sdl_geterror // str -- fill str with BCPL string for the latest SDL error sdl_updaterect // surf, left, top, right, bottom sdl_loadbmp // filename of a .bmp image sdl_blitsurface // src, srcrect, dest, destrect sdl_setcolourkey // surf, flags, colorkey sdl_freesurface // surf sdl_setalpha // surf, flags, alpha sdl_imgload // filename -- using the SDL_image library
253
sdl_delay sdl_flip sdl_displayformat sdl_waitevent sdl_pollevent sdl_getmousestate sdl_loadwav sdl_freewav // // // // // // // // // // msecs -- the SDL delay function surf -- Double buffered update of the screen surf -- convert surf to display format pointer to [type, args, ... ] to hold details of the next event return 0 if no events available pointer to [type, args, ... ] to hold details of the next event return 0 if no events available pointer to [x, y] returns bit pattern of buttons currently pressed file, spec, buff, len buffer
sdl_wm_setcaption // string sdl_videoinfo // v => [ flags, blit_fill, video_mem, vfmt] sdl_maprgb // format, r, g, b sdl_drawline //27 sdl_drawhline //28 sdl_drawvline //29 sdl_drawcircle //30 sdl_drawrect //31 sdl_drawpixel //32 sdl_drawellipse //33 sdl_drawfillellipse //34 sdl_drawround //35 sdl_drawfillround //36 sdl_drawfillcircle //37 sdl_drawfillrect //38 sdl_fillrect sdl_fillsurf //39 //40
// Joystick functions sdl_numjoysticks sdl_joystickopen sdl_joystickclose sdl_joystickname sdl_joysticknumaxes sdl_joysticknumbuttons sdl_joysticknumballs sdl_joysticknumhats
// // // // // // // //
41 42 43 44 45 46 47 48
(index) (index) => joy (index) (index) (joy) (joy) (joy) (joy)
sdl_joystickeventstate //49 sdl_getticks //50 sdl_showcursor //51
sdl_enable=1 or sdl_ignore=0 () => msecs since initialisation
254
sdl_hidecursor sdl_mksurface sdl_setcolourkey sdl_joystickgetbutton sdl_joystickgetaxis sdl_joystickgetball sdl_joystickgethat // more to come ... // SDL events sdl_ignore sdl_enable sdle_active sdle_keydown sdle_keyup sdle_mousemotion sdle_mousebuttondown sdle_mousebuttonup sdle_joyaxismotion sdle_joyballmotion sdle_joyhatmotion sdle_joybuttondown sdle_joybuttonup sdle_quit sdle_syswmevent sdle_videoresize sdle_userevent sdle_arrowup sdle_arrowdown sdle_arrowright sdle_arrowleft //52 //53 //54 //55 //56 //57 //58
APPENDIX A. SDL.H
= 0 = 1 = = = = = = = = = = = = = = = = = = = 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
// eg enable joystick events // // // // // // window gaining or losing focus => mod ch => mod ch => x y => buttonbits => buttonbits
273 274 275 276
sdl_init_everything = #xFFFF sdl_SWSURFACE sdl_HWSURFACE = #x00000000 // Surface is in system memory = #x00000001 // Surface is in video memory
sdl_ANYFORMAT = #x10000000 // Allow any video depth/pixel-format sdl_HWPALETTE = #x20000000 // Surface has exclusive palette sdl_DOUBLEBUF = #x40000000 // Set up double-buffered video mode sdl_FULLSCREEN = #x80000000 // Surface is a full screen display
255
sdl_OPENGL = #x00000002 // Create an OpenGL rendering context sdl_OPENGLBLIT = #x0000000A // Create an OpenGL rendering context and use it for blitting sdl_RESIZABLE = #x00000010 // This video mode may be resized sdl_NOFRAME = #x00000020 // No window caption or edge frame }
Appendix B sdl.b
This appendix give the BCPL source of the SDL library cintcode/g/sdl.b. It is mainly here so I can proof read it on my iPad.
/* ############### UNDER DEVELOPMENT ##################### This library provides some functions that interface with the SDL Graphics libary. Implemented by Martin Richards (c) September 2012 Change history: 26/08/12 Initial implementation.
It should typically be included as a separate section for programs that need it. Such programs typically have the following structure. GET "libhdr" MANIFEST { g_sdlbase=nnn GET "sdl.h" GET "sdl.b" . GET "libhdr" MANIFEST { g_sdlbase=nnn GET "sdl.h" Rest of the program
} // Only used if the default setting of 450 in // libhdr is not suitable. // Insert the library source code
} // Only used if the default setting of 450 in // libhdr is not suitable.
256
257
*/ LET initsdl() = VALOF { LET mes = VEC 256/bytesperword IF sys(Sys_sdl, sdl_init, sdl_init_everything) DO { sys(Sys_sdl, sdl_geterror, mes) writef("Unable to initialise SDL: %s*n", mes) RESULTIS FALSE } // writef("Number of joysticks %2i*n", sys(Sys_sdl, sdl_numjoysticks)) joystick := sys(Sys_sdl, sdl_joystickopen, 0) // writef("Number of axis %2i*n", sys(Sys_sdl, sdl_joysticknumaxes, joystick)) // writef("Number of buttons %2i*n", sys(Sys_sdl, sdl_joysticknumbuttons, joystick)) lefts, rights := 0, 0 leftds, rightds := 0, 0 depthscreen := 0 // Successful RESULTIS TRUE } AND mkscreen(title, xsize, ysize) = VALOF { // Create a screen surface with given title and size LET mes = VEC 256/bytesperword screenxsize, screenysize := xsize, ysize screen := sys(Sys_sdl, sdl_setvideomode, screenxsize, screenysize, 32, sdl_SWSURFACE) UNLESS screen DO { sys(Sys_sdl, sdl_geterror, mes) writef("Unable to set video mode: %s*n", mes) RESULTIS 0 } { // Surface info structure LET flags, fmt, w, h, pitch, pixels, cliprect, refcount = 0, 0, 0, 0, 0, 0, 0, 0 sys(Sys_sdl, sdl_getsurfaceinfo, screen, @flags) format := fmt }
258
APPENDIX B. SDL.B
setcaption(title) selectsurface(screen, xsize, ysize) } AND maprgb(r, g, b) = sys(Sys_sdl, sdl_maprgb, format, r, g, b) AND setcaption(title) BE sys(Sys_sdl, sdl_wm_setcaption, title, 0) AND closesdl() BE { IF lefts DO freevec(lefts) IF rights DO freevec(rights) IF leftds DO freevec(leftds) IF rightds DO freevec(rightds) IF depthscreen DO freevec(depthscreen) sys(Sys_sdl, sdl_quit) } AND setcolour(col) BE colour, prevdrawn := col, FALSE AND setcolourkey(surf, col) BE sys(Sys_sdl, sdl_setcolourkey, surf, col) AND selectsurface(surf, xsize, ysize) BE currsurf, currxsize, currysize := surf, xsize, ysize AND moveto(x, y) BE currx, curry, prevdrawn := x, y, FALSE AND moveto3d(x, y, z) BE currx, curry, currz, prevdrawn := x, y, z, FALSE AND drawto1(x, y) BE { LET mx, my = ?, ? IF x<0 & currx<0 | y<0 & curry<0 | x>=currxsize & currx>=currxsize | y>=currysize & curry>=currysize DO { currx, curry, prevdrawn := x, y, FALSE RETURN } UNLESS prevdrawn DO drawpoint(currx, curry) mx := (x+currx)/2 my := (y+curry)/2
259
TEST (mx=currx | mx=x) & (my=curry | my=y) THEN drawpoint(x, y) ELSE { drawto(mx, my) drawto(x, y) } } AND drawpoint(x, y) BE { // (0, 0) is the bottom left point on the surface prevdrawn := FALSE IF 0<=x<currxsize & 0<=y<currysize DO { sys(Sys_sdl, sdl_fillrect, currsurf, x, currysize-y, 1, 1, colour) prevdrawn := TRUE } currx, curry := x, y } AND drawpoint3d(x, y, z) BE { // (0, 0) is the bottom left point on the surface prevdrawn := FALSE //IF y<2 DO writef("drawpoint3d: (%i3,%i3,%i3)*n", x,y,z) //IF y<0 DO abort(1234) IF 0<=x<currxsize & 0<=y<currysize DO { LET p = @(depthscreen!(x+y*currxsize)) IF z<!p DO { !p := z sys(Sys_sdl, sdl_fillrect, currsurf, x, currysize-y, 1, 1, colour) prevdrawn := TRUE } } currx, curry, currz := x, y, z } AND moveby(dx, dy) BE moveto(currx+dx, curry+dy) AND drawby(dx, dy) BE drawto(currx+dx, curry+dy) AND moveby3d(dx, dy, dz) BE moveto3d(currx+dx, curry+dy, currz+dz) AND drawby3d(dx, dy, dz) BE drawto3d(currx+dx, curry+dy, currz+dz)
AND getevent() = VALOF { //writef("Calling pollevent*n") RESULTIS sys(Sys_sdl, sdl_pollevent, @eventtype) }
260
APPENDIX B. SDL.B
AND sdldelay(msecs) BE // Delay using the SDL delay mechanism sys(Sys_sdl, sdl_delay, msecs)
AND sdlmsecs() = // returns msecs since start of run sys(Sys_sdl, sdl_getticks)
AND hidecursor() = sys(Sys_sdl, sdl_hidecursor) AND showcursor() = sys(Sys_sdl, sdl_showcursor) AND updatescreen() BE // Display the screen sys(Sys_sdl, sdl_flip, screen) AND mksurface(w, h) = VALOF { //writef("mksurface: w=%n h=%n*n", w, h) RESULTIS sys(Sys_sdl, sdl_mksurface, format, w, h) } AND freesurface(surf) BE sys(Sys_sdl, sdl_freesurface, surf) AND blitsurf(src, dst, x, y) BE { // Blit the source surface to the specified position // in the destination surface LET dx, dy, dw, dh = x, currysize-y-1, 0, 0 sys(Sys_sdl, sdl_blitsurface, src, 0, dst, @dx) } AND blitsurfrect(src, srcrect, dst, x, y) BE { // Blit the specified rectangle from the source surface to // the specified position in the destination surface LET dx, dy, dw, dh = x, currysize-y-1, 0, 0 sys(Sys_sdl, sdl_blitsurface, src, srcrect, dst, @dx) } AND fillsurf(col) BE sys(Sys_sdl, sdl_fillsurf, currsurf, col) AND drawch(ch) BE TEST ch=*n THEN { currx, curry := 10, curry-14 } ELSE { FOR line = 0 TO 11 DO write_ch_slice(currx, curry+11-line, ch, line) currx := currx+9
261
} AND write_ch_slice(x, y, ch, line) BE { // Writes the horizontal slice of the given character. // Character are 8x12 LET cx, cy = currx, curry LET i = (ch&#x7F) - *s LET charbase = TABLE // Still under development !!! #X00000000, #X00000000, #X00000000, // space #X18181818, #X18180018, #X18000000, // ! #X66666600, #X00000000, #X00000000, // " #X6666FFFF, #X66FFFF66, #X66000000, // # #X7EFFD8FE, #X7F1B1BFF, #X7E000000, // $ #X06666C0C, #X18303666, #X60000000, // % #X3078C8C8, #X7276DCCC, #X76000000, // & #X18181800, #X00000000, #X00000000, // #X18306060, #X60606030, #X18000000, // ( #X180C0606, #X0606060C, #X18000000, // ) #X00009254, #X38FE3854, #X92000000, // * #X00000018, #X187E7E18, #X18000000, // + #X00000000, #X00001818, #X08100000, // , #X00000000, #X007E7E00, #X00000000, // #X00000000, #X00000018, #X18000000, // . #X06060C0C, #X18183030, #X60600000, // / #X386CC6C6, #XC6C6C66C, #X38000000, // 0 #X18387818, #X18181818, #X18000000, // 1 #X3C7E6206, #X0C18307E, #X7E000000, // 2 #X3C6E4606, #X1C06466E, #X3C000000, // 3 #X1C3C3C6C, #XCCFFFF0C, #X0C000000, // 4 #X7E7E6060, #X7C0E466E, #X3C000000, // 5 #X3C7E6060, #X7C66667E, #X3C000000, // 6 #X7E7E0606, #X0C183060, #X40000000, // 7 #X3C666666, #X3C666666, #X3C000000, // 8 #X3C666666, #X3E060666, #X3C000000, // 9 #X00001818, #X00001818, #X00000000, // : #X00001818, #X00001818, #X08100000, // ; #X00060C18, #X30603018, #X0C060000, // < #X00000000, #X7C007C00, #X00000000, // = #X00603018, #X0C060C18, #X30600000, // > #X3C7E0606, #X0C181800, #X18180000, // ? #X7E819DA5, #XA5A59F80, #X7F000000, // @ #X3C7EC3C3, #XFFFFC3C3, #XC3000000, // A #XFEFFC3FE, #XFEC3C3FF, #XFE000000, // B #X3E7FC3C0, #XC0C0C37F, #X3E000000, // C #XFCFEC3C3, #XC3C3C3FE, #XFC000000, // D
262
#XFFFFC0FC, #XFFFFC0FC, #X3E7FE1C0, #XC3C3C3FF, #X18181818, #X7F7F0C0C, #XC2C6CCD8, #XC0C0C0C0, #X81C3E7FF, #X83C3E3F3, #X7EFFC3C3, #XFEFFC3C3, #X7EFFC3C3, #XFEFFC3C3, #X7EC3C0C0, #XFFFF1818, #XC3C3C3C3, #X81C3C366, #XC3C3C3C3, #XC3C3663C, #XC3C36666, #XFFFF060C, #X78786060, #X60603030, #X1E1E0606, #X10284400, #X00000000, #X30180C00, #X00007AFE, #XC0C0DCFE, #X00007CFE, #X060676FE, #X00007CFE, #X000078FC, #X000076FE, #XC0C0DCFE, #X18180018, #X0C0C000C, #X00C0C6CC, #X00606060, #X00006CFE, #X0000DCFE, #X00007CFE, #X00007CFE, #X00007CFE, #XFCC0C0FF, #XFCC0C0C0, #XCFCFE3FF, #XFFC3C3C3, #X18181818, #X0C0CCCFC, #XF0F8CCC6, #XC0C0C0FE, #XDBC3C3C3, #XDBCFC7C3, #XC3C3C3FF, #XFFFEC0C0, #XDBCFC7FE, #XFFFECCC6, #X7E0303C3, #X18181818, #XC3C3C37E, #X663C3C18, #XDBFFE7C3, #X183C66C3, #X3C3C1818, #X183060FF, #X60606060, #X18180C0C, #X06060606, #X00000000, #X00000000, #X00000000, #XC6C6C6FE, #XC6C6C6FE, #XC6C0C6FE, #XC6C6C6FE, #XC6FCC0FE, #XC0F0F0C0, #XC6C6C6FE, #XC6C6C6C6, #X18181818, #X0C0C0C7C, #XD8F0F8CC, #X6060607C, #XD6D6D6D6, #XC6C6C6C6, #XC6C6C6FE, #XC6FEFCC0, #XC6FE7E06, #XFF000000, #XC0000000, #X7E000000, #XC3000000, #X18000000, #X78000000, #XC2000000, #XFE000000, #XC3000000, #XC1000000, #X7E000000, #XC0000000, #X7D000000, #XC3000000, #X7E000000, #X18000000, #X3C000000, #X18000000, #X81000000, #XC3000000, #X18000000, #XFF000000, #X78780000, #X06060000, #X1E1E0000, #X00000000, #X00FFFF00, #X00000000, #X7B000000, #XDC000000, #X7C000000, #X76000000, #X7C000000, #XC0000000, #X7606FE7C, #XC6000000, #X18000000, #X38000000, #XC6000000, #X38000000, #XD6000000, #XC6000000, #X7C000000, #XC0000000, #X06000000, // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // // E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ a b c d e f g h i j k l m n o p q
APPENDIX B. SDL.B
263
#X0000DCFE, #X00007CFE, #X0060F8F8, #X0000C6C6, #X0000C6C6, #X0000D6D6, #X0000C6C6, #X0000C6C6, #X00007EFE, #X0C181808, #X18181818, #X30181810, #X00000070, #XAA55AA55, #XC6C0C0C0, #XC07C06FE, #X6060607C, #XC6C6C6FE, #X6C6C6C38, #XD6D6D6FE, #X6C386CC6, #XC6C6C67E, #X0C3860FE, #X18301808, #X18181818, #X180C1810, #XD1998B0E, #XAA55AA55, #XC0000000, #X7C000000, #X38000000, #X7C000000, #X10000000, #X6C000000, #XC6000000, #X7606FE7C, #XFC000000, #X18180C00, #X18181800, #X18183000, #X00000000, #XAA55AA55 // // // // // // // // // // // // // // r s t u v w x y z { | } ~ rubout
IF i>=0 DO charbase := charbase + 3*i { LET col = colour LET w = VALOF SWITCHON line INTO { CASE 0: RESULTIS charbase!0>>24 CASE 1: RESULTIS charbase!0>>16 CASE 2: RESULTIS charbase!0>> 8 CASE 3: RESULTIS charbase!0 CASE 4: RESULTIS charbase!1>>24 CASE 5: RESULTIS charbase!1>>16 CASE 6: RESULTIS charbase!1>> 8 CASE 7: RESULTIS charbase!1 CASE 8: RESULTIS charbase!2>>24 CASE 9: RESULTIS charbase!2>>16 CASE 10: RESULTIS charbase!2>> 8 CASE 11: RESULTIS charbase!2 } IF IF IF IF IF IF IF IF ((w >> 7) ((w >> 6) ((w >> 5) ((w >> 4) ((w >> 3) ((w >> 2) ((w >> 1) (w & 1) & & & & & & & 1) 1) 1) 1) 1) 1) 1) = = = = = = = = 1 1 1 1 1 1 1 1 DO DO DO DO DO DO DO DO drawpoint(x, drawpoint(x+1, drawpoint(x+2, drawpoint(x+3, drawpoint(x+4, drawpoint(x+5, drawpoint(x+6, drawpoint(x+7, y) y) y) y) y) y) y) y)
} currx, curry := cx, cy }
264
AND drawstring(x, y, s) BE { moveto(x, y) FOR i = 1 TO s%0 DO drawch(s%i) } AND plotf(x, y, form, a, b, c, d, e, f, g, h) BE { LET oldwrch = wrch LET s = VEC 256/bytesperword plotfstr := s plotfstr%0 := 0 wrch := plotwrch writef(form, a, b, c, d, e, f, g, h) wrch := oldwrch drawstring(x, y, plotfstr) } AND plotwrch(ch) BE { LET strlen = plotfstr%0 + 1 plotfstr%strlen := ch plotfstr%0 := strlen } AND drawto(x, y) BE { // This is Bresenhams algorithm LET dx = ABS(x-currx) AND dy = ABS(y-curry) LET sx = currx<x -> 1, -1 LET sy = curry<y -> 1, -1 LET err = dx-dy LET e2 = ? { drawpoint(currx, curry) IF currx=x & curry=y RETURN e2 := 2*err IF e2 > -dy DO { err := err - dy currx := currx+sx } IF e2 < dx DO { err := err + dx curry := curry + sy } } REPEAT }
APPENDIX B. SDL.B
265
AND drawto3d(x, y, z) BE { // This is Bresenhams algorithm LET dx = ABS(x-currx) AND dy = ABS(y-curry) LET sx = currx<x -> 1, -1 LET sy = curry<y -> 1, -1 LET py = curry<y -> currxsize, -currxsize LET x0, y0, z0 = currx, curry, currz LET err = dx-dy LET e2 = ? //IF y<0 DO //{ writef("drawto3d: x=%n y=%n z=%n*n", x,y,z) // abort(1237) //} { drawpoint3d(currx,curry,currz) IF currx=x & curry=y RETURN e2 := 2*err IF e2 > -dy DO { err := err - dy currx := currx+sx } IF e2 < dx DO { err := err + dx curry := curry + sy } TEST dx>=dy THEN currz := z0 + muldiv(z-z0, currx-x0, x-x0) ELSE currz := z0 + muldiv(z-z0, curry-y0, y-y0) } REPEAT } AND setlims(x, y) BE { // This is used by drawtriangle and is based on Bresenhams algorithm LET dx = ABS(x-currx) AND dy = ABS(y-curry) LET sx = currx<x -> 1, -1 LET sy = curry<y -> 1, -1 LET err = dx-dy IF curry<miny DO miny := curry IF curry>maxy DO maxy := curry { LET e2 = 2*err
266
APPENDIX B. SDL.B
IF currx< lefts!curry DO lefts!curry := currx IF currx>rights!curry DO rights!curry := currx IF currx=x & curry=y RETURN IF e2 > -dy DO { err := err - dy currx := currx + sx } IF e2 < dx DO { err := err + dx curry := curry + sy } } REPEAT } AND alloc2dvecs() BE UNLESS lefts DO { lefts := getvec(currysize-1) rights := getvec(currysize-1) FOR i = 0 TO currysize-1 DO lefts!i, rights!i := maxint, minint } AND drawquad(x1,y1,x2,y2,x3,y3,x4,y4) BE { alloc2dvecs() miny, maxy := maxint, minint moveto(x1,y1) setlims(x2,y2) setlims(x3,y3) setlims(x4,y4) setlims(x1,y1) FOR y = miny TO maxy DO { moveto(lefts!y, y) drawto(rights!y, y) lefts!y, rights!y := maxint, minint } moveto(x1,y1) } AND drawtriangle(x1,y1,x2,y2,x3,y3) BE { alloc2dvecs()
267
miny, maxy := maxint, minint moveto(x1,y1) setlims(x2,y2) setlims(x3,y3) setlims(x1,y1) FOR y = miny TO maxy DO { moveto(lefts!y, y) drawto(rights!y, y) lefts!y, rights!y := maxint, minint } moveto(x1,y1) } AND setlims3d(x, y, z) BE { // This is used by drawtriangle3d and drawquad3d // It is based on Bresenhams algorithm LET dx = ABS(x-currx) AND dy = ABS(y-curry) LET x0, y0, z0 = currx, curry, currz LET sx = currx<x -> 1, -1 LET sy = curry<y -> 1, -1 LET err = dx-dy { LET e2 = 2*err IF 0<=curry<currysize DO { IF curry<miny DO miny := curry IF curry>maxy DO maxy := curry
IF currx <= lefts!curry DO { lefts!curry := currx //IF leftds!curry > currz DO // Bug??? leftds!curry := currz } IF currx >= rights!curry DO { rights!curry := currx //IF rightds!curry > currz DO // Bug??? rightds!curry := currz } } IF currx=x & curry=y RETURN
268
APPENDIX B. SDL.B
IF e2 > -dy DO { err := err - dy currx := currx + sx IF dx>=dy DO { currz := z0 + muldiv(z-z0, currx-x0, x-x0) } } IF e2 < dx DO { err := err + dx curry := curry + sy IF dy>dx DO { currz := z0 + muldiv(z-z0, curry-y0, y-y0) } } } REPEAT } AND alloc3dvecs() BE { UNLESS lefts DO { lefts := getvec(currysize-1) rights := getvec(currysize-1) FOR y = 0 TO currysize-1 DO lefts!y, rights!y := maxint, minint } UNLESS leftds DO { leftds := getvec(currysize-1) rightds := getvec(currysize-1) FOR y = 0 TO currysize-1 DO leftds!y, rightds!y := maxint, maxint } UNLESS depthscreen DO { depthscreen := getvec(currxsize*currysize-1) FOR i = 0 TO currxsize*currysize-1 DO depthscreen!i := maxint } } AND drawquad3d(x1,y1,z1, x2,y2,z2, x3,y3,z3, x4,y4,z4) BE { // Draw a filled convex quadralateral // The points are assumed to be coplanar alloc3dvecs()
269
//IF x1=400 & y1=7 DO //{ writef("drawquad3d: // writef("drawquad3d: // writef("drawquad3d: // writef("drawquad3d: // abort(1235) //} miny, maxy := maxint, moveto3d (x1,y1,z1) setlims3d(x2,y2,z2) setlims3d(x3,y3,z3) setlims3d(x4,y4,z4) setlims3d(x1,y1,z1) //IF miny<0 DO //{ writef("drawquad3d: miny=%n maxy=%n*n", miny, maxy) // abort(1236) //} FOR y = miny TO maxy DO { moveto3d( lefts!y, y, leftds!y) drawto3d(rights!y, y, rightds!y) lefts!y, rights!y := maxint, minint leftds!y, rightds!y := maxint, maxint } moveto3d(x1,y1,z1) } AND drawtriangle3d(x1,y1,z1, x2,y2,z2, x3,y3,z3) BE { alloc3dvecs() miny, maxy := maxint, minint moveto3d (x1,y1,z1) setlims3d(x2,y2,z2) setlims3d(x3,y3,z3) setlims3d(x1,y1,z1) FOR y = miny TO maxy DO { moveto3d( lefts!y, y, leftds!y) drawto3d(rights!y, y, rightds!y) lefts!y, rights!y := maxint, minint leftds!y, rightds!y := maxint, maxint
x1=%i5 x2=%i5 x3=%i5 x4=%i5
y1=%i5 y2=%i5 y3=%i5 y4=%i5
z1=%i5*n", z2=%i5*n", z3=%i5*n", z4=%i5*n",
x1,y1,z1) x2,y2,z2) x3,y3,z3) x4,y4,z4)
minint
270
} moveto3d(x1,y1,z1) } AND drawrect(x0, y0, x1, y1) BE { LET xmin, xmax = x0, x1 LET ymin, ymax = y0, y1 IF xmin>xmax DO xmin, xmax := x1, x0 IF ymin>ymax DO ymin, ymax := y1, y0 FOR x = xmin TO xmax DO { drawpoint(x, ymin) drawpoint(x, ymax) } FOR y = ymin+1 TO ymax-1 DO { drawpoint(xmin, y) drawpoint(xmax, y) } currx, curry := x0, y0 } AND drawfillrect(x0, y0, x1, y1) BE { LET xmin, xmax = x0, x1 LET ymin, ymax = y0, y1 IF xmin>xmax DO xmin, xmax := x1, x0 IF ymin>ymax DO ymin, ymax := y1, y0
APPENDIX B. SDL.B
sys(Sys_sdl, sdl_fillrect, currsurf, xmin, currysize-ymax, xmax-xmin+1, ymax-ymin+1, colour) /* FOR x = xmin TO xmax FOR y = ymin TO ymax DO { drawpoint(x, y) } */ currx, curry := x0, y0 } AND drawroundrect(x0,y0,x1,y1,radius) BE { LET xmin, xmax = x0, x1 LET ymin, ymax = y0, y1 LET r = radius LET f, ddf_x, ddf_y, x, y = ?, ?, ?, ?, ? IF xmin>xmax DO xmin, xmax := x1, x0 IF ymin>ymax DO ymin, ymax := y1, y0
271
IF r<0 DO r := 0 IF r+r>xmax-xmin DO r := (xmax-xmin)/2 IF r+r>ymax-ymin DO r := (ymax-ymin)/2 FOR x = xmin+r TO xmax-r DO { drawpoint(x, ymin) drawpoint(x, ymax) } FOR y = ymin+r+1 TO ymax-r-1 DO { drawpoint(xmin, y) drawpoint(xmax, y) } // Now draw the rounded corners // This is commonly called Bresenhams circle algorithm since it // is derived from Bresenhams line algorithm. f := 1 - r ddf_x := 1 ddf_y := -2 * r x := 0 y := r drawpoint(xmax, drawpoint(xmin, drawpoint(xmax, drawpoint(xmin, ymin+r) ymin+r) ymax-r) ymax-r)
WHILE x<y DO { // ddf_x = 2*x + 1 // ddf_y = -2 * y // f = x*x + y*y - radius*radius IF f>=0 DO { y := y-1 ddf_y := ddf_y + 2 f := f + ddf_y } x := x+1 ddf_x := ddf_x + 2 f := f + ddf_x drawpoint(xmax-r+x, ymax-r+y) // drawpoint(xmin+r-x, ymax-r+y) // drawpoint(xmax-r+x, ymin+r-y) // drawpoint(xmin+r-x, ymin+r-y) // drawpoint(xmax-r+y, ymax-r+x) // drawpoint(xmin+r-y, ymax-r+x) // drawpoint(xmax-r+y, ymin+r-x) //
+ 2*x - y + 1
octant Octant Octant Octant Octant Octant Octant
2 3 7 6 1 4 8
272
drawpoint(xmin+r-y, ymin+r-x) // Octant 5 } currx, curry := x0, y0 } AND drawfillroundrect(x0, y0, x1, y1, radius) BE { LET xmin, xmax = x0, x1 LET ymin, ymax = y0, y1 LET r = radius LET f, ddf_x, ddf_y, x, y = ?, ?, ?, ?, ? LET lastx, lasty = 0, 0 IF IF IF IF IF xmin>xmax DO xmin, ymin>ymax DO ymin, r<0 DO r := 0 r+r>xmax-xmin DO r r+r>ymax-ymin DO r xmax := x1, x0 ymax := y1, y0 := (xmax-xmin)/2 := (ymax-ymin)/2
APPENDIX B. SDL.B
FOR x = xmin TO xmax FOR y = ymin+r TO ymax-r DO { drawpoint(x, y) drawpoint(x, y) } // Now draw the rounded corners // This is commonly called Bresenhams circle algorithm since it // is derived from Bresenhams line algorithm. f := 1 - r ddf_x := 1 ddf_y := -2 * r x := 0 y := r drawpoint(xmax, drawpoint(xmin, drawpoint(xmax, drawpoint(xmin, WHILE x<y DO { // ddf_x = // ddf_y = // f = x*x IF f>=0 DO { y := y-1 ddf_y := ymin+r) ymin+r) ymax-r) ymax-r)
2*x + 1 -2 * y + y*y - radius*radius + 2*x - y + 1
ddf_y + 2
273
f := f + ddf_y } x := x+1 ddf_x := ddf_x + 2 f := f + ddf_x drawpoint(xmax-r+x, drawpoint(xmin+r-x, drawpoint(xmax-r+x, drawpoint(xmin+r-x, drawpoint(xmax-r+y, drawpoint(xmin+r-y, drawpoint(xmax-r+y, drawpoint(xmin+r-y,
ymax-r+y) ymax-r+y) ymin+r-y) ymin+r-y) ymax-r+x) ymax-r+x) ymin+r-x) ymin+r-x)
// // // // // // // //
octant Octant Octant Octant Octant Octant Octant Octant
2 3 7 6 1 4 8 5
UNLESS x=lastx DO { FOR fx = xmin+r-y+1 TO xmax-r+y-1 DO { drawpoint(fx, ymax-r+x) drawpoint(fx, ymin+r-x) } lastx := x } UNLESS y=lasty DO { FOR fx = xmin+r-x+1 TO xmax-r+x-1 DO { drawpoint(fx, ymax-r+y) drawpoint(fx, ymin+r-y) } } } currx, curry := x0, y0 } AND drawcircle(x0, y0, radius) BE { // This is commonly called Bresenhams circle algorithm since it // is derived from Bresenhams line algorithm. LET f = 1 - radius LET ddf_x = 1 LET ddf_y = -2 * radius LET x = 0 LET y = radius drawpoint(x0, y0+radius) drawpoint(x0, y0-radius) drawpoint(x0+radius, y0) drawpoint(x0-radius, y0)
274
WHILE x<y DO { // ddf_x = 2*x + 1 // ddf_y = -2 * y // f = x*x + y*y - radius*radius + 2*x - y + 1 IF f>=0 DO { y := y-1 ddf_y := ddf_y + 2 f := f + ddf_y } x := x+1 ddf_x := ddf_x + 2 f := f + ddf_x drawpoint(x0+x, y0+y) drawpoint(x0-x, y0+y) drawpoint(x0+x, y0-y) drawpoint(x0-x, y0-y) drawpoint(x0+y, y0+x) drawpoint(x0-y, y0+x) drawpoint(x0+y, y0-x) drawpoint(x0-y, y0-x) } }
APPENDIX B. SDL.B
AND drawfillcircle1(x0, y0, radius) BE { IF y0<radius DO y0 := radius IF y0>=currysize-radius DO y0 := currysize-radius sys(Sys_sdl, sdl_drawfillcircle, currsurf, x0, currysize-y0, radius, colour) }
AND drawfillcircle(x0, y0, radius) BE { // This is commonly called Bresenhams circle algorithm since it // is derived from Bresenhams line algorithm. LET f = 1 - radius LET ddf_x = 1 LET ddf_y = -2 * radius LET x = 0 LET y = radius LET lastx, lasty = 0, 0 drawpoint(x0, y0+radius) drawpoint(x0, y0-radius) FOR x = x0-radius TO x0+radius DO drawpoint(x, y0) WHILE x<y DO { // ddf_x = 2*x + 1
275
// ddf_y = -2 * y // f = x*x + y*y - radius*radius + 2*x - y + 1 IF f>=0 DO { y := y-1 ddf_y := ddf_y + 2 f := f + ddf_y } x := x+1 ddf_x := ddf_x + 2 f := f + ddf_x drawpoint(x0+x, y0+y) drawpoint(x0-x, y0+y) drawpoint(x0+x, y0-y) drawpoint(x0-x, y0-y) drawpoint(x0+y, y0+x) drawpoint(x0-y, y0+x) drawpoint(x0+y, y0-x) drawpoint(x0-y, y0-x) UNLESS x=lastx DO { FOR fx = x0-y+1 TO x0+y-1 DO { drawpoint(fx, y0+x) drawpoint(fx, y0-x) } lastx := x } UNLESS y=lasty DO { FOR fx = x0-x+1 TO x0+x-1 DO { drawpoint(fx, y0+y) drawpoint(fx, y0-y) } lasty := y } } } AND getmousestate() = VALOF { writef("*ngetmousestate: not available*n") abort(999) }

Catalog C

Uploaded by

Copyright:

Available Formats

Catalog C

Uploaded by

Document Information

Original Description:

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Catalog C

Uploaded by

Copyright:

Available Formats

Young Persons Guide to BCPL Programming on the Raspberry Pi

Chapter 1 Setting up the Raspberry Pi

CHAPTER 1. SETTING UP THE RASPBERRY PI

Figure 1.3: A more extensive setup

CHAPTER 1. SETTING UP THE RASPBERRY PI

Chapter 2 SD Card Initialisation

CHAPTER 2. SD CARD INITIALISATION

CHAPTER 2. SD CARD INITIALISATION

CHAPTER 2. SD CARD INITIALISATION

Chapter 3 Introduction to Linux

CHAPTER 3. INTRODUCTION TO LINUX

3.1. THE FILING SYSTEM

The Filing System

CHAPTER 3. INTRODUCTION TO LINUX

3.2. THE DESKTOP

CHAPTER 3. INTRODUCTION TO LINUX

3.4. EDITING FILES

20 GET "libhdr" LET start() = VALOF { writef("Hello World!*n") RESULTIS 0 }

CHAPTER 3. INTRODUCTION TO LINUX

3.6. EMACS cintsys c bc hello hello

CHAPTER 3. INTRODUCTION TO LINUX

Chapter 4 The BCPL Cintcode System

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

4.1. INSTALLATION OF BCPL

IF toname DO { TEST appending THEN tostream := findappend(toname) ELSE tostream := findoutput(toname)

4.2. HELLO WORLD

32 Code size = 0.130> 0.000> hello Hello World! 0.020> 60 bytes

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

WHILE i<=2 DO { writef("Position %n a := b b := c

4.3. FIBONACCI c := a+b i := i+1 } RESULTIS 0 }

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

90 100 110 120 99 110 121 132

96 108 120 132 144

4.5. A MATHEMATICIANS APPROACH X2

The rule has

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

Applications of XOR and MOD

4.7. APPLICATIONS OF XOR AND MOD

CHAPTER 4. THE BCPL CINTCODE SYSTEM

RSA Mathematical Details

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

%32b*n", i, f!i, f!i)

CHAPTER 4. THE BCPL CINTCODE SYSTEM

MANIFEST, GLOBAL and STATIC declarations

//SYSLIB //SYSLIB //SYSLIB

MR 18/7/01 changed to G:5 MR 6/5/05 MR 6/5/04

// For compatibility with native BCPL

CHAPTER 4. THE BCPL CINTCODE SYSTEM

CHAPTER 4. THE BCPL CINTCODE SYSTEM

Value %12u*n", i, fib(i))

4.12. SOLVING THE RECURRENCE RELATION FOR C

8i+1), 8i+4), 8i+5), 8i+6),

8i+1) 8i+4) 8i+5) 8i+6)