Copy Link
Add to Bookmark
Report
The Basix Fanzine issue 09
The BASIX Fanzine Issue 9 - October 1997
editor: Alex Warren
Welcome to Issue 9 of the Basix Fanzine, and hello from your new editor! It's
been about eight months since the last Fanzine and during that time Peter
Cooper decided that he didn't have time to edit this any more, so the
editorship has now passed to me.
As a result, the internet addresses for the Fanzine have changed. The new
email address for articles etc. is basix@dewarr.globalnet.co.uk and the new
www address is http://www.users.globalnet.co.uk/~dewarr/basix.htm. Any other
queries etc. can be mailed to dewarr@globalnet.co.uk.
I hope you enjoy this issue of the Fanzine. If you have any comments or want
to submit an article, please feel free to email me, as all input is very much
appreciated.
If you submitted an article to Peter Cooper and it has not appeared in this
issue, please email your article to basix@dewarr.globalnet.co.uk. Thanks in
advance.
-CONTENTS---------------------------------------------------------------------
Levels are represented by B, I or A for Beginner, Intermediate and Advanced
respectively, or a combination. Unless otherwise stated, the articles apply to
all major breeds of BASIC.
NEWS:
- BASIX FANZINE INTERACTIVE LIBRARY
- THE VISUAL BASIX?
ARTICLES:
- MOUSE PROGRAMMING by Alex Warren [not QBasic] (I/A)
- BINARY by Alex Warren (B/I)
- GRAPHICS ROTATION (2D) by Alex Warren (I)
PROGRAMS:
- PRIME GENERATOR by Judson D. McClendon
- PLASMA by Alex Warren
- FONT PLACEMENT II by Byron Smith
- PALETTE ROUTINES by Joe Lawrence
LETTERS:
- Q&A
- Programming MIDI
- Disabling Ctrl+Alt+Del
- The QBasic Site
INTERNET RESOURCES:
- Getting the Fanzine
- Websites
- Mailing List
- Useful BASIC Websites
- Useful BASIC Newsgroups
FINAL WORDS
-NEWS-------------------------------------------------------------------------
*** BASIX FANZINE INTERACTIVE LIBRARY ****************************************
The brand new Basix Fanzine Interactive Library will soon be at:
http://www.geocities.com/SiliconValley/Horizon/2451/
It will contain ALL the articles ever featured in the fanzine, in an HTML
format, categorized into sections such as Sound Card programming, Graphics,
etc.
All new articles will be placed straight into the library, and these new
articles will be regularly compiled into a text-format fanzine every month or
so, just as they do now. This means that the text-based fanzine will NOT
actually change, just that the articles featured in it will be available at
the Fanzine Library before they appear in the fanzine.
I would appreciate your comments on this - please email dewarr@globalnet.co.uk
if you have any comments or suggestions.
NOTE! The Interactive Library is NOT YET online. It will take quite a while to
convert all the fanzine articles, but I hope there will be at least *some* of
it ready by the end of November.
*** THE VISUAL BASIX? ********************************************************
I am considering bringing out a separate, HTML-based fanzine site for Visual
Basic (for Windows) tips and programs. It would work like the Basix Fanzine
Interactive Library but there would probably not be a regular text file. I
would very much appreciate your views on this - please email any ideas to
dewarr@globalnet.co.uk.
-ARTICLES---------------------------------------------------------------------
*** MOUSE PROGRAMMING, by Alex Warren ****************************************
Mouse programming is fairly easy - all you need to know are the various
interrupts involved. First you will need to start QB/etc. with the /L option
- this loads the quick library which you will need to access the mouse
functions. In your program you will need to put the following lines near
the start:
REM $INCLUDE: 'QB.BI'
DIM inregs AS regtype, outregs AS regtype
You will now be ready to use the various mouse functions. Each mouse
function is called using interrupt 33h, like this:
inregs.ax = n
CALL INTERRUPT (&H33, inregs, outregs)
where n is the function number.
To initialize the mouse, use function 0, i.e.:
inregs.ax = 0
CALL INTERRUPT (&H33, inregs, outregs)
You will always need to execute these lines to get the mouse to work
at all. These lines also detect whether a mouse is present, with the
result returned in outregs. If outregs.ax=-1 after using the above
lines, a mouse is present.
Next you will probably want to show the mouse, so use function 1 and
you should see your mouse shown as a grey block in SCREEN 0:
inregs.ax = 1
CALL INTERRUPT (&H33, inregs, outregs)
In graphics modes the mouse is shown as an arrow.
Now you'll want to know how to recognise mouse button clicks and how
to find out the coordinates of the mouse pointer. To do this, use
function 3. The following things are returned:
outregs.bx will be the button clicked: 0 - no buttons
clicked
1 - left button
2 - right button
3 - both buttons
outregs.cx the x coordinate
outregs.dx the y coordinate
The x and y coordinates are usually given as pixels, but in SCREEN 13
you'll need to divide the outregs.cx value by 2 to get the x value. To
get text coordinates, i.e. 80x25 if you're in SCREEN 0, divide
outregs.cx and outregs.dx by 8, like this:
x = INT(outregs.cx / 8) + 1
y = INT(outregs.dx / 8) + 1
Here's an example program. It waits until the user clicks a button on
the screen, and then exits. It uses the interrupt line in a SUB to
save typing and program space. Note that if you do this you will need
to make the inregs and outregs variables SHARED. (Sorry about the
split LOOP line, you'll have to make that all one line if you paste
it into QB)
' Sample mouse program from BASIX Fanzine Issue 9
' ** Remember to run QB with the /L option to load libraries **
'$INCLUDE: 'QB.BI'
DECLARE SUB mouse()
DIM SHARED inregs AS REGTYPE, outregs AS REGTYPE
SCREEN 13
inregs.ax = 0 : mouse
LINE(10, 10) - (50, 50), 10, B
inregs.ax = 1 : mouse
DO
inregs.ax = 3 : mouse
LOOP UNTIL outregs.bx = 1 AND (outregs.cx / 2 > 9 AND outregs.cx / 2
< 51 AND outregs.dx > 9 AND outregs.dx < 51)
END
SUB mouse()
CALL INTERRUPT (&H33, inregs, outregs)
END SUB
Important note about mouse programming: If you draw something to the
screen where the mouse is you'll find the mouse wipes that bit of the
screen when it is moved - try it. Use function 1 to display the mouse
in SCREEN 13, PAINT the screen green then move the mouse. It leaves a
black square behind - this is the area of the original black screen
before it was PAINTed. To stop this happening, use function 2 to hide
the mouse while making changes to the screen, then function 1 to show
it again after the changes have been made.
You can set the mouse position using function 4, where inregs.cx is
the x co-ordinate and inregs.dx is the y co-ordinate. For example, to
set the mouse position to (30, 40) you would use:
inregs.ax = 4
inregs.cx = 30
inregs.dx = 40
CALL INTERRUPT (&H33, inregs, outregs)
(remember to multiply cx by 2 in screen 13)
Finally, here are two more functions. They limit where the mouse can
go so you can 'trap' it inside an area of screen. You'll need to use
inregs.cx as x1 or y1, and inregs.dx as x2 or y2. The functions are:
7 Limit mouse on x-axis
8 Limit on y-axis.
So to trap the mouse between (5, 5) and (315, 195) in SCREEN 13, use
this:
inregs.ax = 7 ' limit x-axis
inregs.cx = 10 ' i.e. 5*2
inregs.dx = 630 ' i.e. 315*2
inregs.ax = 8 ' limit y-axis
inregs.cx = 5
inregs.dx = 195
mouse
*** BINARY NUMBERS, by Alex Warren *******************************************
Binary is a way of representing numbers as a collection of "0"s and
"1"s. Each 0 or 1 in a binary number represents a number. The last digit
represents 1, the second from last 2, the third from last 4, the fourth
from last 8, etc. - doubling each time. This is represented below:
Digit no. 1 2 3 4 5 6 7 8
------------------------------------------------------------------------
Represents 128 64 32 16 8 4 2 1
We use this to turn binary numbers into normal decimal numbers, like
this:
BINARY: 1 0 1 1 0 0 1 0
Where we have a digit '1' above we will add the number it represents to the
decimal number we want to obtain, so the binary number 10110010 above
represents 128+32+16+2 (as these numbers all have "one"s under them), which is
178.
Here are some more examples:
Binary 1010 = Decimal 8+2 = 10
Binary 1111 = Decimal 8+4+2+1 = 15
Binary 1000 = Decimal 8 = 8
If you want it explained another way:
Counting in binary is like counting in decimal, except we can only use
the digits "0" and "1". So the first ten binary numbers are:
BINARY DECIMAL
0 0
1 1
10 2
11 3
100 4
101 5
110 6
111 7
1000 8
1001 9
1010 10
The program below asks for a binary number and converts it into a
decimal number using the same method as above:
INPUT "Enter binary number:", num$
x = (2 ^ LEN(num$)) / 2
n = 0
FOR i = 1 TO LEN(num$)
IF MID$(num$, i, 1) = "1" THEN n = n + x
x = x / 2
NEXT i
PRINT n
Here, num$ is the binary number. x is initialized to the value of the
first binary digit, for example in the case of 101 this will be 8,
and with 10110010 this will be 128. The FOR loop should hopefully be
self-explanatory.
The reverse of this process changes decimal numbers to binary. This
is done easiest using bitwise comparison.
It is done in BASIC using the following:
IF number AND bindigit THEN .....
where the variable "number" is your decimal number and "binval" is your binary
digit, ie 1, 2, 4, 8, 16, 32, 64 etc. So to check whether the decimal 17
includes the binary digit for 2, you would something similar to:
IF 17 AND 2 THEN PRINT "17 includes 2"
The following program uses the method above to convert any decimal
number into binary.
DIM digit(100) AS STRING
INPUT "Decimal:", decimal
n = 1: d = 1
DO
IF decimal AND n THEN
digit(d) = "1"
ELSE
digit(d) = "0"
END IF
n = n * 2
d = d + 1
LOOP UNTIL n > decimal
PRINT "Binary: ";
FOR i = d - 1 TO 1 STEP -1
PRINT digit(i);
NEXT i
PRINT
Note how bad this program is, I made it up quickly and it generates the binary
numbers backwards! That's why I have the FOR i = d - 1 to 1 STEP -1 line.
That's it for making binary numbers, but one big question is WHY we would want
to use binary numbers.
Well, if you want to make programs that make use of interrupts, a great
deal of them need binary numbers passed to them. Each digit of the
binary number is usually referred to as a "bit". So, you collect all
your bits together and turn them into a decimal/hexadecimal number,
which you can then pass to your interrupt. (BTW, if you want to convert
your decimal into a hexadecimal number use the BASIC function HEX$)
Binary numbers also have their uses in saving memory and in making
faster, more efficient programs. Here's an example:
If we have conducted a survey of eight questions, each one answered YES
or NO, we could store each person's entire answers in just one single
character - normally, you might save the answers to disk as a list of Y
or N characters, eg YYYNNYNY. If we change Y to 1 and N to 0, we get the
binary number 11100101. We can then convert this to the decimal, which
will be 128+64+32+4+1 = 229. Use CHR$ to turn this into its ASCII
character, and there you have eight answers as one character, taking up
one eighth of the space. If you are saving lots of people's answers to
disk this will save you a LOT of space. We can then extract the original
answers from the number 229 using the method above to get the number
11100101, which you can then convert back to the answers YES, YES, YES,
NO, NO, YES, NO, YES.
You could apply this technique to lots of other things, for example
it can be used in computer games. For example, if you were making an
adventure game, etc., and had a 'Save Game' facility, you could make
each item the player can collect represent a binary digit, eg:
Coin Food Spade Axe Bucket Bowl Sword
If the player has collected the food, bucket and sword you would
convert to binary:
0 1 0 0 1 0 1
So you would convert the binary number 0100101 into decimal and save
as a character. If you have hundreds of items you could split these
up into blocks of eight and save each block as a character.
When reading back your character and converting it to a decimal, you could use
bitwise comparison to check for the spade, for instance. You would use
something similar to:
items = ASC(itemchar$)
spadevalue = 16
IF items AND spadevalue THEN playergotspade = TRUE
Saving binary data into one eighth of the space not only saves on disk space
and memory, it also saves on speed as it is faster to convert for example 100
ASCII characters into the 800 pieces of data they represent than to load eight
times as much data, since hard disks are generally quite slow (this is why
virtual memory under Windows is so slow and more RAM will speed up your
system). This is a much more professional way of saving data.
One important thing to bear in mind when saving data in this way is that you
*MUST* use OPEN filename$ FOR BINARY, and not OPEN filename$ FOR OUTPUT etc.
This is because OPEN filename$ FOR INPUT will not read some chracters
correctly, particularly the null (character 0) and the EOF characaters
(character 26). Saving these values in a text file (which OPEN FOR
INPUT/OUTPUT/etc. is designed for) will often not work correctly.
If you have any more questions then please email dewarr@globalnet.co.uk.
*** GRAPHICS ROTATION (2D), by Alex Warren ***********************************
Many people seem to want to know how to rotate 2D graphics, and in this
article I'll show you how to do it using fairly simple trigonometry.
An important rule for rotation is the following:
In this rather bad ASCII-art circle of radius 1, point X is at (1,0) and O is
the origin at (0,0):
*****
** | **
* | *
*_____|O____X
* | *
* | *
** | **
*****
If we rotate X by A degrees/radians anticlockwise, trigonometry tells us that
it will end up at point (COS(A),SIN(A)), which is how we rotate point X.
This is fine if you just want to draw a circle without using the CIRCLE
command perhaps, but it's a bit more complex if you want to use it for
rotation.
The following program will rotate any graphic or text that you put into it -
the explanation of how it works comes after the program. Run it first though
and see that it does indeed work.
DEFINT A-Z
CONST pi! = 3.141593
' Define co-ordinates of box to rotate here, with (0,0) at the centre of the
' screen. BOXX1 = left co-or, BOXX2 = right co-or, BOXY1 = top co-or,
' BOXY2= bottom co-or, ie rectangle defined by (BOXX1, BOXY1)-(BOXX2, BOXY2)
CONST BOXX1 = -12
CONST BOXX2 = 12
CONST BOXY1 = -12
CONST BOXY2 = 12
DIM r!(BOXX1 TO BOXX2, BOXY1 TO BOXY2)
DIM a!(BOXX1 TO BOXX2, BOXY1 TO BOXY2)
DIM p(BOXX1 TO BOXX2, BOXY1 TO BOXY2)
FOR x = BOXX1 TO BOXX2
FOR y = BOXY1 TO BOXY2
r!(x, y) = SQR((x ^ 2) + (y ^ 2))
IF x < 0 THEN r!(x, y) = -r!(x, y)
IF x = 0 THEN a!(x, y) = (pi / 4) ELSE a!(x, y) = ATN(y / x)
NEXT y
NEXT x
SCREEN 7
WINDOW (-160, 100)-(160, -100) ' We set the co-ordinate system of the screen so
' that the point (0,0) is in the centre of the
' screen.
' *** INSERT DRAWING CODE HERE, ETC. ***
LINE (-12, 12)-(12, -12), 15, B
LINE (-11, 11)-(11, -11), 12, B
LINE (-12, 12)-(12, -12), 13
LINE (-12, -12)-(12, 12), 14
' *** END OF DRAWING CODE ***
FOR x = BOXX1 TO BOXX2
FOR y = BOXY1 TO BOXY2
p(x, y) = POINT(x, y)
NEXT y
NEXT x
a$ = INPUT$(1)
' Rotation code here. Note that angles are in RADIANS where 2ã rads=360ø
' (Characters in above comment may show incorrectly under Windows, it should
' read 2pi rads=360 degrees)
curpage = 0
DO
FOR angle! = 0 TO 2 * pi! STEP .1
SCREEN 7, , curpage, 1 - curpage
CLS
FOR x = BOXX1 TO BOXX2
FOR y = BOXY1 TO BOXY2
newx = COS(angle! + a!(x, y)) * r!(x, y)
newy = SIN(angle! + a!(x, y)) * r!(x, y)
PSET (newx, newy), p(x, y)
NEXT y
NEXT x
curpage = 1 - curpage
NEXT angle!
LOOP UNTIL INKEY$ = CHR$(27)
So how does this program use the above rule to rotate graphics? Well, it has
to split up the entire graphic into circles and work out the angle of each
point subtended at the centre of the circle. Sounds complicated? OK, here it
is another way, using an example point P. The point (0,0) is O.
|
P |
_______|O______
|
|
The co-ordinates of point P are (-4,2) in this example. We can work out which
circle P is in by finding the distance between P and the point O (hence the
radius of the circle). We can do this using Pythagoras' Theorem, which will
tell us that the radius of the circle R is SQR((X^2)+(Y^2)).
Next we need to work out P's angle in its circle, otherwise all points in the
same circle would end up being plotted to the same point. We can work out P's
angle using a!(x, y) = ATN(y / x). The function ATN in BASIC returns the
inverse TAN, ie the same result as pressing -------
| -1|
|tan |
------- on a calculator.
This will tell us the angle "A" of the point "P", in radians:
P
\
\
\A
------ (1,0)
So we work out the values R (radius) and A (angle) of each point BEFORE we
rotate, and then we can use them during our rotation loop, like this:
newx = COS(angle! + a!(x, y)) * r!(x, y)
newy = SIN(angle! + a!(x, y)) * r!(x, y)
This uses the (COS(A),SIN(A)) rule above, with A being the angle of rotation
added to the angle of the point P. The co-ordinate obtained is then multiplied
by the radius of P's circle.
We then work out the values of newx and newy for each point in our rotation
area, and plot newx and newy. We can use a FOR loop or similar to animate the
rotation, as in the program above.
-PROGRAMS---------------------------------------------------------------------
*** PRIMES.BAS, by Judson D. McClendon (judmc@mindspring.com) ****************
Here is a program from Judson D. McClendon, which demonstrates a simple way of
finding prime numbers.
"Judson D. McClendon" <judmc@mindspring.com> writes:
Note that there are much more sophisticated methods of determining
primality. But if you are generating a table of primes, this method is
pretty efficient and straightforward. Tables of primes can be very useful in
pseudo random number generator algorithms, hashing algorithms, etc.
'
' **************************************************
' * *
' * PRIMES.BAS *
' * *
' * Calculates Prime Numbers *
' * *
' * Version 1.1 05-22-96 *
' * *
' * Compiled with Microsoft QuickBASIC 4.0 *
' * *
' * Judson D. McClendon *
' * 329 37th Court N.E. *
' * Birmingham, AL 35215 *
' * 205-853-8440 *
' * *
' **************************************************
'
DEFLNG A-Z
CONST TableSize = 3500
CONST MaxColumns = 8
CONST FALSE = 0, TRUE = NOT FALSE
DIM PrimeTable(1 TO TableSize)
CLS
PRINT "Compute Prime Numbers"
PRINT "Screen, Printer, Disk or Count (S/P/D/C): ";
DO
PrintType$ = UCASE$(INKEY$)
LOOP WHILE (PrintType$ <> "S" AND PrintType$ <> "P" AND PrintType$ <> "D" AND PrintType$ <> "C")
PRINT PrintType$
INPUT "Enter Maximum Prime <= 999,999,999: ", MaxPrime
PRINT "Printing Prime Numbers from 1 to"; MaxPrime
IF (PrintType$ = "P") THEN
OPEN "LPT1:" FOR OUTPUT AS #1
PRINT #1, "Prime Numbers from 1 to"; MaxPrime
PRINT #1, ""
ELSEIF (PrintType$ = "D") THEN
OPEN "PRIMES.DAT" FOR OUTPUT AS #1
PRINT #1, "Prime Numbers from 1 to"; MaxPrime
PRINT #1, ""
ELSE
OPEN "SCRN:" FOR OUTPUT AS #1
END IF
' Initialize Table
DATA 2,2,3
READ TableEntries
FOR TablePointer = 1 TO TableEntries
READ PrimeTable(TablePointer)
IF (PrintType$ <> "C") THEN
PRINT #1, USING "#########"; PrimeTable(TablePointer);
ColumnCount = ColumnCount + 1
IF (ColumnCount < MaxColumns) THEN
PRINT #1, " ";
ELSE
PRINT #1, ""
ColumnCount = 0
END IF
END IF
NEXT
PrimeCount = TableEntries
' Loop by 2's
FOR Number = 5 TO MaxPrime STEP 2
TableOverflow = TRUE ' Reset on good test
FOR TablePointer = 2 TO TableEntries
TestFactor = PrimeTable(TablePointer)
Quotient = Number \ TestFactor ' Note \ is integer division
IF (Number = Quotient * TestFactor) THEN
TableOverflow = FALSE
EXIT FOR
ELSE
IF (Quotient <= TestFactor) THEN
IF (TableEntries < TableSize) THEN
TableEntries = TableEntries + 1
PrimeTable(TableEntries) = Number
END IF
PrimeCount = PrimeCount + 1
IF (PrintType$ <> "C") THEN
PRINT #1, USING "#########"; Number;
ColumnCount = ColumnCount + 1
IF (ColumnCount < MaxColumns) THEN
PRINT #1, " ";
ELSE
PRINT #1, ""
ColumnCount = 0
END IF
END IF
TableOverflow = FALSE
EXIT FOR
END IF
END IF
NEXT
IF (TableOverflow = TRUE) THEN
PRINT #1, ""
PRINT #1, "** Table not large enough **"
EXIT FOR
END IF
NEXT
PRINT #1, ""
PRINT #1, PrimeCount; "Primes Found"
IF (PrintType$ = "P") THEN
PRINT #1, CHR$(12);
END IF
CLOSE #1
*** PLASMA.BAS, by Alex Warren ***********************************************
The following program is one that I sent to Pete Cooper in February for
inclusion in the fanzine - I didn't realise at the time that it would be ME
that eventually put it in!
The program makes a disgusting slimey mess in screen 13 but it's as slow as
hell! If anyone can find a way to speed it up, please email me. Thanks in
advance.
' Plasma v1.2
' by Alex Warren, February 1997
' dewarr@globalnet.co.uk
DECLARE SUB pal (n AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER)
DEFINT A-Z
DIM ol(320)
RANDOMIZE TIMER
SCREEN 13: CLS
FOR z = 1 TO 63
pal z, z, z, 0
NEXT z
sc = INT(RND * 53) + 10
PSET (1, 1), sc
ol(1) = sc
oc = sc
FOR x = 2 TO 320
v = INT(RND * 5) - 2
p = oc + v
IF p > 63 THEN p = 63
IF p < 10 THEN p = 10
IF p <> 10 THEN PSET (x, 1), p
oc = p
ol(x) = p
NEXT x
oavg = 0
FOR ay = 2 TO 200
FOR x = 1 TO 320
IF x = 1 THEN op1 = ol(x) ELSE op1 = oavg
op2 = ol(x)
IF x = 320 THEN op3 = ol(x) ELSE op3 = ol(x + 1)
avg = (op1 + op2 + op3) / 3
v = INT(RND * 7) - 3
avg = avg + v
IF avg > 63 THEN avg = 63
IF avg < 10 THEN avg = 10
PSET (x, ay), avg
oavg = avg
ol(x) = avg
NEXT x
NEXT ay
A$ = INPUT$(1)
DEFSNG A-Z
SUB pal (n AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER)
OUT &H3C8, n
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, b
END SUB
*** FONT PLACEMENT II, by Byron Smith ****************************************
This is another version of the Font Placement routines featured in Issue 8;
this version is about twice as fast. Note that Byron's email address is now
curt@datarecall.net.
DECLARE SUB fontput (z1%, y1%, in$, c%)
DECLARE SUB fontput2x (x%, y%, t$, c%)
DEFINT A-Z
RANDOMIZE TIMER
SCREEN 12
CLS
PAINT (1, 1), 1
fontput 0, 0, "The old algorithm...", 2
fontput 258, 8, "FontPut Demo", 0
fontput 260, 10, "FontPut Demo", 15
fontput 20, 30, "I dont expect you to use this procedure but it uses a technique unknown", 15
fontput 20, 50, "to many programmers. It reads direct from the font area in ROM, instead", 15
fontput 25, 70, "of using the method used by many programmers in which they PRINT their", 15
fontput 30, 90, "text and then use the POINT command... so you can use this method in", 15
fontput 20, 110, "place of that old method, look at the fontput procedure.. Cheers {:o)", 15
fontput 20, 150, "Peter Cooper", 14
A$ = INPUT$(1)
CLS
fontput 1, 1, "PRESS ANY KEY TO EXIT!", 12
A$ = INKEY$
DO
x% = INT((550 - 0 + 1) * RND + 0)
y% = INT((470 - 1 + 1) * RND + 1)
c% = INT((15 - 1 + 1) * RND + 1)
fontput x%, y%, "Hello there!", c%
LOOP UNTIL INKEY$ <> ""
SCREEN 13
CLS
FOR c% = 30 TO 16 STEP -1
fontput1 130, 80, "Cheers!", c%
FOR d% = 1 TO 1000
FOR d2% = 1 TO 40
NEXT d2%
NEXT d%
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
NEXT c%
LOCATE 25, 1: PRINT "Press any key to continue";
WHILE LEN(INKEY$) = 0: WEND
SCREEN 12
CLS
PAINT (1, 1), 1
fontput2x 0, 0, "The ", 2
fontput2x 32, 0, "NEW ", 10
fontput2x 64, 0, "algorithm...", 2
fontput2x 258, 8, "FontPut Demo", 0
fontput2x 260, 10, "FontPut Demo", 15
fontput2x 20, 30, "I dont expect you to use this procedure but it uses a technique unknown", 15
fontput2x 20, 50, "to many programmers. It reads direct from the font area in ROM, instead", 15
fontput2x 25, 70, "of using the method used by many programmers in which they PRINT their", 15
fontput2x 30, 90, "text and then use the POINT command... so you can use this method in", 15
fontput2x 20, 110, "place of that old method, look at the fontput procedure.. Cheers {:o)", 15
fontput2x 20, 150, "Peter Cooper", 14
A$ = INPUT$(1)
CLS
fontput2x 1, 1, "PRESS ANY KEY TO EXIT!", 12
A$ = INKEY$
DO
x% = INT((550 - 0 + 1) * RND + 0)
y% = INT((470 - 1 + 1) * RND + 1)
c% = INT((15 - 1 + 1) * RND + 1)
fontput2x x%, y%, "Hello there!", c%
LOOP UNTIL INKEY$ <> ""
SCREEN 13
CLS
FOR c% = 30 TO 16 STEP -1
fontput2x 130, 80, "Cheers!", c%
FOR d% = 1 TO 1000
FOR d2% = 1 TO 40
NEXT d2%
NEXT d%
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
NEXT c%
SUB fontput (z1%, y1%, in$, c%)
DEF SEG = &HFFA6
o1% = z1%
FOR l% = 1 TO LEN(in$)
l$ = MID$(in$, l%, 1)
FOR y% = y1% TO y1% + 7
x% = PEEK(&HE + (ASC(l$) * 8) + (y% - y1%))
FOR z% = 0 TO 7
IF x% AND (2 ^ (7 - z%)) THEN PSET (z1%, y%), c%
z1% = z1% + 1
NEXT z%
z1% = z1% - 8
NEXT y%
z1% = z1% + 8
NEXT l%
DEF SEG
END SUB
'Author: Byron Smith <unol@sat.net> http://www.sat.net/~unol 28-JAN-1997
'Experimental fontput2 codenamed X2-LPR
SUB fontput2x (x%, y%, t$, c%)
DEF SEG = -90
tmp$ = t$ + " "
PRESET (x% + 15, y% - 1)
FOR b% = 1 TO LEN(tmp$) - 1 STEP 2
o1% = 14 + 8 * ASC(MID$(tmp$, b%, 1))
o2% = 14 + 8 * ASC(MID$(tmp$, b% + 1, 1))
FOR m% = 0 TO 7
d& = 256& * PEEK(o1% + m%) + PEEK(o2% + m%)
IF d& > 32767 THEN d% = d& - 65536 ELSE d% = d&
LINE STEP(-15, 1)-STEP(15, 0), c%, , d%
NEXT m%
PRESET STEP(16, -8)
NEXT b%
END SUB
*** PALETTE ROUTINES, by Joe Lawrence ****************************************
Joe Lawrence wrote the palette article in issue 6, and has kindly donated this
useful program demonstrating some useful palette effects:
' -- Palette Routine Demo Program! ----------------------- by Joe Lawrence --
' Use integers to speed things up...
DEFINT A-Z
' -- Subroutine Declarations ------------------------------------------------
' General palette routines
DECLARE SUB PalGradient (palmem%, colour1$, colour2$, cstart%, cend%)
DECLARE SUB PalRGBSet (palmem%, red%, green%, blue%, cindex%)
DECLARE SUB PalRefresh (palmem%)
DECLARE SUB PalInit ()
DECLARE SUB PalBrightness (palmem%, power%)
DECLARE SUB PalAntiAlias (palmem%)
DECLARE SUB PalBlur (palmem%)
DECLARE FUNCTION PalColorDither% (palmem%, r%, g%, b%)
' Looping routines
DECLARE SUB PalFade (palmem%, color$, cstart%, cendc%)
DECLARE SUB PalMorph (palmem1%, palmem2%, cstart%, cend%, hues%)
DECLARE SUB PalRotate (palmem%, cstart%, cend%, offset%)
' Actual disk I/O
DECLARE SUB PalDiskKill (File$)
DECLARE SUB PalDiskLoad (palmem%, File$)
DECLARE SUB PalDiskSave (palmem%, File$)
' Palette memory maintenance
DECLARE SUB PalMemAssign (palmem%)
DECLARE SUB PalMemCopy (palmem1%, palmem2%)
DECLARE SUB PalMemDefault (palmem%)
DECLARE SUB PalMemMove (palmem1%, palmem2%)
DECLARE SUB PalMemSwap (palmem1%, palmem2%)
' -- Option Variables -------------------------------------------------------
DIM SHARED visualpal AS INTEGER
DIM SHARED palettes AS INTEGER
DIM SHARED definedcolors AS INTEGER
palettes% = 10 ' Total number of palettes in memory
definedcolors% = 15 ' Total number of defined colors in PalInit
visualpal% = 1 ' The visual palette
' -- Data Types -------------------------------------------------------------
' The default data-type stores the default palette
TYPE default
r AS INTEGER: g AS INTEGER: b AS INTEGER
END TYPE
' The pal data-type stores custom palette data
TYPE pal
r AS INTEGER: g AS INTEGER: b AS INTEGER
END TYPE
' The colour data-type stores predefined color data
TYPE colour
r AS INTEGER: g AS INTEGER: b AS INTEGER: title AS STRING * 10
END TYPE
DIM SHARED pal(palettes, 256) AS pal
DIM SHARED colour(definedcolors) AS colour
DIM SHARED default(256) AS default
' -- Macros -----------------------------------------------------------------
CONST PalWait% = 966 ' VAL("&H3C6")
CONST PalRead% = 967 ' VAL("&H3C7")
CONST PalWrite% = 968 ' VAL("&H3C8")
CONST PalRGB% = 969 ' VAL("&H3C9")
' -- Main Program -----------------------------------------------------------
SCREEN 13 ' 320x200x256
RANDOMIZE TIMER ' We want different random numbers
CALL PalInit ' Sets up predefined and default colors
PRINT "PalGradient"
' PalGradient: Smoothly fades two colors
' Syntax: CALL PalGradient (palette, color1$, color2$, start_color, end_color)
CALL PalGradient(1, "RED", "GREEN", 1, 32)
CALL PalGradient(1, "GREEN", "BLUE", 32, 63)
CALL PalGradient(1, "BLUE", "YELLOW", 63, 95)
CALL PalGradient(1, "YELLOW", "RED", 95, 126)
' Here we demonstrate it's use in creating smooth lines
FOR x% = 0 TO 319
cindex! = cindex! + 126 / 320
LINE (x%, 10)-(x%, 199), cindex!
NEXT x%
SLEEP 2
' PalRotate: Rotates a palette by offset color index(es)
' Syntax: CALL PalRotate (palette, start_color, end_color, offset)
LOCATE 1: PRINT "PalRotate "
' Here we use it to simulate animation at two different speeds.
SLEEP 2
LOCATE 1, 40: PRINT "1"
FOR cindex% = 1 TO 126
CALL PalRotate(1, 1, 126, 1) ' 1, which is the offset here controls speed
NEXT
SLEEP 1
LOCATE 1, 40: PRINT "2"
FOR cindex% = 1 TO 63
CALL PalRotate(1, 1, 126, 2) ' 2, the offset, speeds things up at the loss
NEXT ' of the fluidness of an offset of 1.
LOCATE 1, 40: PRINT " "
' PalFade: Fades a palette into a solid color.
' Syntax: CALL PalFade (palette, color$, start_color, end_color)
' PalMemCopy: Copies a palette in memory to another location in memory.
' Syntax: CALL PalMemCopy (palette_source, palette_destination)
CALL PalMemCopy(1, 2) ' Make a temporary copy to use later
LOCATE 1: PRINT "PalFade "
SLEEP 2
CALL PalFade(1, "RANDOM", 1, 126) ' Fade into a random color
SLEEP 2
CALL PalFade(1, "BLACK", 1, 126) ' Now fade-out into black
' PalMemDefault: Restores a palette in memory to the standard-default.
' Syntax: CALL PalMemDefault (palette)
LOCATE 1: PRINT "PalMemRestore"
CALL PalMemDefault(1)
SLEEP 2
' PalAntiAlias: Smoothes out a palette, reduces sharp color differences.
' Syntax: CALL PalAntiAlias (palette)
LOCATE 1: PRINT "PalAntiAlias "
SLEEP 2
CALL PalAntiAlias(1)
CALL PalAntiAlias(1)
SLEEP 2
' PalBlur: Smudges a palette, greatly reduces sharp color differences.
' Syntax: CALL PalAntiAlias (palette)
CALL PalMemDefault(1) ' Undo the Anti-aliasing
LOCATE 1: PRINT "PalBlur "
SLEEP 2
CALL PalBlur(1)
CALL PalBlur(1)
SLEEP 2
' PalBrightness: (In/De)creases a palette's brightness
' Syntax: CALL PalBrightness (palette, brightness_power)
LOCATE 1: PRINT "PalBrightness"
SLEEP 2
CALL PalBrightness(1, 16)
SLEEP 2
CALL PalBrightness(1, -32)
SLEEP 2
' PalMorph: Smoothly morphs one palette in memory into another.
' Syntax: CALL PalMorph (palette_start, palette_end, start_color, end_color)
LOCATE 1: PRINT "PalMorph "
SLEEP 1
CALL PalMorph(1, 2, 1, 126, 63) ' We're going to do all 63 hues. (100%)
SLEEP 2
' PalDiskSave: Saves a palette in memory to disk.
' Syntax: CALL PalDiskSave (palette, "Drive:\Path\Filename.Ext")
' PalDiskLoad: Load a palette from disk to memory
' Syntax: CALL PalDiskLoad (palette, "Drive:\Path\Filename.Ext")
' PalDiskKill: Erase a palette file from disk
' Syntax: CALL PalDiskKill ("Drive:\Path\Filename.Ext")
LOCATE 1: PRINT "PalDiskSave"
CALL PalDiskSave(1, "C:\TEMP.PAL") ' Save palette to temporary file
SLEEP 1
CALL PalMemDefault(1) ' Change palette to default
SLEEP 1
LOCATE 1: PRINT "PalDiskLoad"
CALL PalDiskLoad(1, "C:\TEMP.PAL") ' Load saved palette
CALL PalDiskKill("C:\TEMP.PAL") ' Delete temporary palette file
SLEEP 2
SCREEN 0: WIDTH 80, 25: PRINT "By Joe Lawrence"
SYSTEM
SUB PalAntiAlias (palmem%)
' Find the average of each color index's surrounding RGB values and itself's.
FOR cindex% = 2 TO 254
pal(0, cindex%).r = CINT((pal(palmem%, cindex% - 1).r + pal(palmem%, cindex% + 1).r + pal(palmem%, cindex%).r) / 3)
pal(0, cindex%).g = CINT((pal(palmem%, cindex% - 1).g + pal(palmem%, cindex% + 1).g + pal(palmem%, cindex%).g) / 3)
pal(0, cindex%).b = CINT((pal(palmem%, cindex% - 1).b + pal(palmem%, cindex% + 1).b + pal(palmem%, cindex%).b) / 3)
NEXT cindex%
' Make corrections for color indexes 1 and 255
pal(0, 1).r = CINT((pal(palmem%, 1).r + pal(palmem%, 2).r) / 2)
pal(0, 1).g = CINT((pal(palmem%, 1).g + pal(palmem%, 2).g) / 2)
pal(0, 1).b = CINT((pal(palmem%, 1).b + pal(palmem%, 2).b) / 2)
pal(0, 255).r = CINT((pal(palmem%, 255).r + pal(palmem%, 254).r) / 2)
pal(0, 255).g = CINT((pal(palmem%, 255).g + pal(palmem%, 254).g) / 2)
pal(0, 255).b = CINT((pal(palmem%, 255).b + pal(palmem%, 254).b) / 2)
' Copy the temporary palette to palmem%
FOR cindex% = 1 TO 255
pal(palmem%, cindex%).r = pal(0, cindex%).r
pal(palmem%, cindex%).g = pal(0, cindex%).g
pal(palmem%, cindex%).b = pal(0, cindex%).b
NEXT cindex%
CALL PalRefresh(palmem%)
END SUB
SUB PalBlur (palmem%)
' PalMemBlur is basically PalMemAntiAlias, only a little warped. The end
' effect is a nice blur of the palette.
' Find the average of each color index's surrounding RGB values and itself's.
FOR cindex% = 3 TO 254
pal(0, cindex%).r = CINT((pal(palmem%, cindex% - 2).r + pal(palmem%, cindex% - 1).r + pal(palmem%, cindex% + 2).r + pal(palmem%, cindex% + 2).r + pal(palmem%, cindex%).r) / 5)
pal(0, cindex%).g = CINT((pal(palmem%, cindex% - 2).g + pal(palmem%, cindex% - 1).g + pal(palmem%, cindex% + 2).g + pal(palmem%, cindex% + 2).g + pal(palmem%, cindex%).g) / 5)
pal(0, cindex%).b = CINT((pal(palmem%, cindex% - 2).b + pal(palmem%, cindex% - 1).b + pal(palmem%, cindex% + 2).b + pal(palmem%, cindex% + 2).b + pal(palmem%, cindex%).b) / 5)
NEXT cindex%
' Make corrections for color indexes 1 and 255
pal(0, 1).r = CINT((pal(palmem%, 1).r + pal(palmem%, 2).r) / 2)
pal(0, 1).g = CINT((pal(palmem%, 1).g + pal(palmem%, 2).g) / 2)
pal(0, 1).b = CINT((pal(palmem%, 1).b + pal(palmem%, 2).b) / 2)
pal(0, 255).r = CINT((pal(palmem%, 255).r + pal(palmem%, 254).r) / 2)
pal(0, 255).g = CINT((pal(palmem%, 255).g + pal(palmem%, 254).g) / 2)
pal(0, 255).b = CINT((pal(palmem%, 255).b + pal(palmem%, 254).b) / 2)
' Copy the temporary palette to palmem%
FOR cindex% = 1 TO 255
pal(palmem%, cindex%).r = pal(0, cindex%).r
pal(palmem%, cindex%).g = pal(0, cindex%).g
pal(palmem%, cindex%).b = pal(0, cindex%).b
NEXT cindex%
CALL PalAntiAlias(palmem%)
END SUB
SUB PalBrightness (palmem%, power%)
' PalBrightness controls the brightness of a palette. By using positive or
' negitive powers, you can either brighten or darken a palette accordingly.
' Note: you may want to change the following line to "FOR cindex% = 0 TO 255"
' if you also want to change the background color.
FOR cindex% = 1 TO 255
' (In/De)crease RGB powers
pal(palmem%, cindex%).r = pal(palmem%, cindex%).r + power%
pal(palmem%, cindex%).g = pal(palmem%, cindex%).g + power%
pal(palmem%, cindex%).b = pal(palmem%, cindex%).b + power%
' Check to make sure they're not to high or low
IF pal(palmem%, cindex%).r > 63 THEN pal(palmem%, cindex%).r = 63
IF pal(palmem%, cindex%).r < 0 THEN pal(palmem%, cindex%).r = 0
IF pal(palmem%, cindex%).g > 63 THEN pal(palmem%, cindex%).g = 63
IF pal(palmem%, cindex%).g < 0 THEN pal(palmem%, cindex%).g = 0
IF pal(palmem%, cindex%).b > 63 THEN pal(palmem%, cindex%).b = 63
IF pal(palmem%, cindex%).b < 0 THEN pal(palmem%, cindex%).b = 0
NEXT cindex%
CALL PalRefresh(palmem%)
END SUB
FUNCTION PalColorDither% (palmem%, r%, g%, b%)
FOR offset% = 0 TO 63
FOR cindex% = 0 TO 255
IF r% - offset% <= pal(palmem%, cindex%).r AND r% + offset% >= pal(palmem%, cindex%).r THEN
IF g% - offset% <= pal(palmem%, cindex%).g AND g% + offset% >= pal(palmem%, cindex%).g THEN
IF b% - offset% <= pal(palmem%, cindex%).b AND b% + offset% >= pal(palmem%, cindex%).b THEN
PalColorDither% = cindex%
EXIT FUNCTION
END IF
END IF
END IF
NEXT
NEXT
END FUNCTION
SUB PalDiskKill (File$)
' Simple enough
KILL File$
END SUB
SUB PalDiskLoad (palmem%, File$)
' Open up File$ as file 99, cycle through all color indexes, read RGB data
' from File$, save them into memory, and finally refresh the palette.
OPEN File$ FOR INPUT AS #99
FOR cindex% = 1 TO 255
IF EOF(99) THEN EXIT FOR
INPUT #99, pal(palmem%, cindex%).r
IF EOF(99) THEN EXIT FOR
INPUT #99, pal(palmem%, cindex%).g
IF EOF(99) THEN EXIT FOR
INPUT #99, pal(palmem%, cindex%).b
NEXT cindex%
CLOSE #99
CALL PalRefresh(palmem%)
END SUB
SUB PalDiskSave (palmem%, File$)
' Open up File$ as file 99, cycle through all color indexes, read RGB data
' from memory, then finally save them.
OPEN File$ FOR OUTPUT AS #99
FOR cindex% = 0 TO 255
PRINT #99, pal(palmem%, cindex%).r; ","; pal(palmem%, cindex%).g; ","; pal(palmem%, cindex%).b; ",";
NEXT
CLOSE #99
END SUB
SUB PalFade (palmem%, color$, cstart%, cend%)
' Check to see if color$ = "RANDOM", if so, assign a random color.
IF UCASE$(color$) = UCASE$("RANDOM") THEN
r% = INT(RND * definedcolors) + 1
red% = colour(r).r
green% = colour(r).g
blue% = colour(r).b
END IF
' Scan to see if color$ equals any of PalInit's defined colors
FOR cindex% = 1 TO definedcolors%
IF RTRIM$(UCASE$(color$)) = RTRIM$(UCASE$(colour(cindex%).title)) THEN
red% = colour(cindex%).r
green% = colour(cindex%).g
blue% = colour(cindex%).b
END IF
NEXT cindex%
' Create a temporary palette in memory.
FOR cindex% = 0 TO 255
pal(0, cindex%).r = red%
pal(0, cindex%).g = green%
pal(0, cindex%).b = blue%
NEXT cindex%
' Fade the temporary palette with palmem%
CALL PalMorph(palmem%, 0, cstart%, cend%, 63)
END SUB
SUB PalGradient (palmem%, color1$, color2$, cstart%, cend%)
ctotal% = cend% - cstart%
' See if color1$ or color2$ = "RANDOM", if so, create a random color. Note:
' color1$ won't equal color2$ if _both_ are "RANDOM"
IF UCASE$(color1$) = UCASE$("RANDOM") THEN
r% = INT(RND * definedcolors%) + 1
red% = colour(r).r
green% = colour(r).g
blue% = colour(r).b
END IF
IF UCASE$(color2$) = UCASE$("RANDOM") THEN
DO: r2% = INT(RND * definedcolors%) + 1: LOOP UNTIL r2% <> r%
red2% = colour(r2).r
green2% = colour(r2).g
blue2% = colour(r2).b
END IF
' Now let's check if the color1$ or color2$ are one of PalInit's defined
' colors. We use RTRIM to chop off any unnecessary spaces. (Remember in the
' colour data-type declaration we declared title AS STRING * 10)
FOR cindex% = 1 TO definedcolors%
IF RTRIM$(UCASE$(color1$)) = RTRIM$(UCASE$(colour(cindex%).title)) THEN
red% = colour(cindex%).r
green% = colour(cindex%).g
blue% = colour(cindex%).b
END IF
IF RTRIM$(UCASE$(color2$)) = RTRIM$(UCASE$(colour(cindex%).title)) THEN
red2% = colour(cindex%).r
green2% = colour(cindex%).g
blue2% = colour(cindex%).b
END IF
NEXT cindex%
' Find the difference between each color's RGB values and divide them by the
' the color indexes used to make the transition smooth.
FOR cindex% = cstart% TO cend%
IF red% - red2% <> 0 THEN minusr! = (red% - red2%) / ctotal%
IF green% - green2% <> 0 THEN minusg! = (green% - green2%) / ctotal%
IF blue% - blue2% <> 0 THEN minusb! = (blue% - blue2%) / ctotal%
NEXT cindex%
' Finally cycle through the color indexes and save new RGB data to memory,
' then refresh the palette.
r! = red%: g! = green%: b! = blue%
FOR cindex% = cstart% TO cend%
pal(palmem%, cindex%).r = r!
pal(palmem%, cindex%).g = g!
pal(palmem%, cindex%).b = b!
r! = r! - minusr!
g! = g! - minusg!
b! = b! - minusb!
NEXT cindex%
CALL PalRefresh(palmem%)
END SUB
SUB PalInit
' Primary Colors
colour(1).title = "red": colour(1).r = 63: colour(1).g = 0: colour(1).b = 0
colour(2).title = "green": colour(2).r = 0: colour(2).g = 63: colour(2).b = 0
colour(3).title = "blue": colour(3).r = 0: colour(3).g = 0: colour(3).b = 63
' Homogeneous Mixtures
colour(4).title = "yellow": colour(4).r = 63: colour(4).g = 63: colour(4).b = 0
colour(5).title = "purple": colour(5).r = 63: colour(5).g = 0: colour(5).b = 63
colour(6).title = "cyan": colour(6).r = 0: colour(6).g = 63: colour(6).b = 63
colour(7).title = "white": colour(7).r = 63: colour(7).g = 63: colour(7).b = 63
colour(8).title = "grey": colour(8).r = 32: colour(8).g = 32: colour(8).b = 32
' Heterogeneous Mixtures
colour(9).title = "orange": colour(9).r = 63: colour(9).g = 32: colour(9).b = 0
colour(10).title = "pink": colour(10).r = 63: colour(10).g = 0: colour(10).b = 32
colour(11).title = "sky": colour(11).r = 0: colour(11).g = 32: colour(11).b = 63
colour(12).title = "mint": colour(12).r = 0: colour(12).g = 63: colour(12).b = 32
colour(13).title = "violet": colour(13).r = 32: colour(13).g = 0: colour(13).b = 63
colour(14).title = "maroon": colour(14).r = 32: colour(14).g = 0: colour(14).b = 16
colour(15).title = "forest": colour(15).r = 0: colour(15).g = 16: colour(15).b = 0
' First we reset the palette, then cycle through all 256 color indexes and
' save their RGB data for use in the default data-type.
PALETTE
FOR cindex% = 0 TO 255
OUT PalRead, cindex%
OUT PalRead, cindex%
default(cindex%).r = INP(PalRGB)
default(cindex%).g = INP(PalRGB)
default(cindex%).b = INP(PalRGB)
FOR p% = 0 TO palettes%
pal(p%, cindex%).r = default(cindex%).r
pal(p%, cindex%).g = default(cindex%).g
pal(p%, cindex%).b = default(cindex%).b
NEXT p%
NEXT cindex%
END SUB
SUB PalMemAssign (palmem%)
' PalMemAssign saves the palette on the screen, the visual one, to a
' specified palette in memory.
FOR cindex% = 0 TO 255
OUT PalRead%, cindex%
pal(palmem%, cindex%).r = INP(PalRGB%)
pal(palmem%, cindex%).g = INP(PalRGB%)
pal(palmem%, cindex%).b = INP(PalRGB%)
NEXT cindex%
END SUB
SUB PalMemCopy (palmem1%, palmem2%)
' PalMemCopy copies palmem1% onto palmem2% and then refreshes the palette.
FOR cindex% = 0 TO 255
pal(palmem2%, cindex%).r = pal(palmem1%, cindex%).r
pal(palmem2%, cindex%).g = pal(palmem1%, cindex%).g
pal(palmem2%, cindex%).b = pal(palmem1%, cindex%).b
NEXT cindex%
CALL PalRefresh(palmem2%)
END SUB
SUB PalMemDefault (palmem%)
' PalMemDefaults changes a palette in memory to the default palette, then
' refreshes the palette.
FOR cindex% = 0 TO 255
' Restore palmem1% to defaults
pal(palmem%, cindex%).r = default(cindex%).r
pal(palmem%, cindex%).g = default(cindex%).g
pal(palmem%, cindex%).b = default(cindex%).b
NEXT cindex%
CALL PalRefresh(palmem%)
END SUB
SUB PalMemMove (palmem1%, palmem2%)
' Now we move palmem1% onto palmem2%, restoring palmem1% to the default
' colors. Like usual, we refresh the palette.
FOR cindex% = 0 TO 255
' Copy palmem1% onto palmem2%
pal(palmem2%, cindex%).r = pal(palmem1%, cindex%).r
pal(palmem2%, cindex%).g = pal(palmem1%, cindex%).g
pal(palmem2%, cindex%).b = pal(palmem1%, cindex%).b
' Restore palmem1% to defaults
pal(palmem1%, cindex%).r = default(cindex%).r
pal(palmem1%, cindex%).g = default(cindex%).g
pal(palmem1%, cindex%).b = default(cindex%).b
NEXT cindex%
CALL PalRefresh(palmem2%)
END SUB
SUB PalMemSwap (palmem1%, palmem2%)
' PalMemSwap simple switches palmem1% with palmem2% and refreshes the
' palette.
FOR cindex% = 0 TO 255
SWAP pal(palmem2%, cindex%).r, pal(palmem1%, cindex%).r
SWAP pal(palmem2%, cindex%).g, pal(palmem1%, cindex%).g
SWAP pal(palmem2%, cindex%).b, pal(palmem1%, cindex%).b
NEXT cindex%
CALL PalRefresh(palmem1%)
CALL PalRefresh(palmem2%)
END SUB
SUB PalMorph (palmem1%, palmem2%, cstart%, cend%, hues%)
' Okay, first cycle though the desired number of hues, stored in variable
' hues%, and all color indexes between cstart% and cend%
FOR hue% = 0 TO hues%
FOR cindex% = cstart% TO cend%
' Do our own PalRefresh routine...
IF visualpal% = palmem1% THEN
WAIT PalWait, 8
OUT PalWrite, cindex%
OUT PalRGB, pal(palmem1%, cindex%).r
OUT PalRGB, pal(palmem1%, cindex%).g
OUT PalRGB, pal(palmem1%, cindex%).b
END IF
' Do our own PalRefresh routine...
IF visualpal% = palmem2% THEN
WAIT PalWait, 8
OUT PalWrite, cindex%
OUT PalRGB, pal(palmem2%, cindex%).r
OUT PalRGB, pal(palmem2%, cindex%).g
OUT PalRGB, pal(palmem2%, cindex%).b
END IF
' (In/De)crease RGB values accordingly.
IF pal(palmem1%, cindex%).r > pal(palmem2%, cindex%).r THEN pal(palmem1%, cindex%).r = pal(palmem1%, cindex%).r - 1
IF pal(palmem1%, cindex%).g > pal(palmem2%, cindex%).g THEN pal(palmem1%, cindex%).g = pal(palmem1%, cindex%).g - 1
IF pal(palmem1%, cindex%).b > pal(palmem2%, cindex%).b THEN pal(palmem1%, cindex%).b = pal(palmem1%, cindex%).b - 1
IF pal(palmem1%, cindex%).r < pal(palmem2%, cindex%).r THEN pal(palmem1%, cindex%).r = pal(palmem1%, cindex%).r + 1
IF pal(palmem1%, cindex%).g < pal(palmem2%, cindex%).g THEN pal(palmem1%, cindex%).g = pal(palmem1%, cindex%).g + 1
IF pal(palmem1%, cindex%).b < pal(palmem2%, cindex%).b THEN pal(palmem1%, cindex%).b = pal(palmem1%, cindex%).b + 1
NEXT cindex%
NEXT hue%
END SUB
SUB PalRefresh (palmem%)
' If palmem% is the palette in memory we're using on the screen,
' visual-palette, then refresh it...
IF palmem% = visualpal% THEN
FOR cindex% = 0 TO 255
WAIT PalWait, 8
OUT PalWrite, cindex%
OUT PalRGB%, pal(palmem%, cindex%).r
OUT PalRGB%, pal(palmem%, cindex%).g
OUT PalRGB%, pal(palmem%, cindex%).b
NEXT cindex%
END IF
END SUB
SUB PalRGBSet (palmem%, red%, green%, blue%, cindex%)
' This simply sets one color index's RGB values and refreshes the palette.
' It's more of a manual way of changing palettes.
pal(palmem%, cindex%).r = red%
pal(palmem%, cindex%).g = green%
pal(palmem%, cindex%).b = blue%
CALL PalRefresh(palmem%)
END SUB
SUB PalRotate (palmem%, cstart%, cend%, offset%)
' PalMemRotate simply shifts a palette by offset% color index(es). When used
' in a loop, you can create the effect of illusion. Note: for best results
' make sure the first and last color indexes' RGB values match.
DIM r%(256), g%(256), b%(256)
a% = cstart% + offset% - 1
FOR cindex% = cstart% TO cend%
a% = a% + 1: IF a% > cend% THEN a% = cstart%
pal(palmem%, cindex%).r = pal(palmem%, a%).r
pal(palmem%, cindex%).g = pal(palmem%, a%).g
pal(palmem%, cindex%).b = pal(palmem%, a%).b
NEXT cindex%
' We'll put our own copy of PalRefresh to speed things up a notch.
IF palmem% = visualpal% THEN
FOR cindex% = 0 TO 255
WAIT PalWait, 8
OUT PalWrite, cindex%
OUT PalRGB%, pal(palmem%, cindex%).r
OUT PalRGB%, pal(palmem%, cindex%).g
OUT PalRGB%, pal(palmem%, cindex%).b
NEXT cindex%
END IF
END SUB
-LETTERS----------------------------------------------------------------------
*** Q&A **********************************************************************
Both of the following emails were posted to Peter Cooper, and unfortunately I
can't answer either of them! If anyone can answer any of these, please email
the Fanzine and/or the relevant person.
- PROGRAMMING MIDI, from Joe Alloway (jalloway@sprintmail.com)
Dear Peter:
I am very interested in playing MIDI or MIDI-type files in QBASIC (1.1). I
need to know how to do this because I want to be able to put high quality
music into my games but I don't like using FM type music. What I am looking
for is some kind of QBASIC file or sub that will let me play an entire MIDI
(.MID or .RMI) file. PLEASE HELP ME! Thank you for your help!
Peter tells me you should have a look for Mike Huff's MIDI engines, though I
don't know where they are...
- DISABLING CTRL+ALT+DELETE, from Nicholas Damewood (greywolf1@hotmail.com)
For some time I have been trying to find the code for disabeling
the Ctrl-Alt-Delete command . I have found on method , but it does not
work !! Help!!!
*** THE QBASIC SITE, from Daniel Hedsn (daniel.hedsen@mn.medstroms.se) *******
Hello!
I have put your Basic page on my homepage "The QBasic Site" and woundering
if you could submit me page to your linkpage.
The adress to my page is: http://hem.passagen.se/hedsen
Sincerely yours
//Daniel Hedsn
This page has been added to the "Useful Basic Websites" section below.
-INTERNET RESOURCES-----------------------------------------------------------
*** GETTING THE FANZINE ******************************************************
- Websites
The Basix Fanzine is available at:
http://www.users.globalnet.co.uk/~dewarr/basix.htm
The Basix Fanzine Interactive Library will be at:
http://www.geocities.com/SiliconValley/Horizon/2451/
(note that the Library is not there at the moment)
- Newsgroups
The Basix Fanzine is posted when it is released to alt.lang.basic,
alt.lang.powerbasic, comp.lang.basic.misc and microsoft.public.basic.dos. If
you want it posted to any other BASIC newsgroups then please let me know.
- Mailing List
To get the Fanzines as they are released, join Tony Relyea's mailing list by
sending an email to the new address of fanzine@vt.edu with subject "subscribe
basix-fanzine"
*** USEFUL BASIC WEBSITES ****************************************************
New addresses for sites featured before in the fanzine are marked with a !.
Totally new sites never featured before are marked with a *.
-PowerBASIC http://www.powerbasic.com/
-QBasic.com http://www.qbasic.com/
-The Programmer's Page http://www.professionals.com/~peterp/
!ABC http://www.xs4all.nl/~excel/pbabc.html
-PowerBasic Archives http://pitel-lnx.ibk.fnt.hvu.nl/~excel/pb.html
*Tim's QuickBasic Page http://www.geocities.com/SiliconValley/Heights/8967/
*QBasic Programming Corner
http://www.geocities.com/TheTropics/9964/qbasic.html
!Zephyr Software http://www.zephyrsoftware.com
-PCGPE ftp://x2ftp.oulu.fi/pub/msdos/programming/gpe
-Blood 225's BASIC stuff ftp://users.aol.com/blood225
*The QBasic Site http://hem.passagen.se/hedsen
!Basix Fanzine http://www.users.globalnet.co.uk/~dewarr/basix.htm
*My BASIC page http://www.users.globalnet.co.uk/~dewarr/basic.htm
*Basix Fanzine Interactive Library
http://www.geocities.com/SiliconValley/Horizon/2451/
THIS MONTH'S SELECTION OF GOOD SITES:
I've picked out a few of the best sites above for you here:
- QBASIC.COM
This site contains hundreds of great programs to download demonstrating the
mouse, graphics, games and more besides.
- TIM'S QUICKBASIC PAGE **NEW**
This page contains lots of useful programs available for download.
- ZEPHYR SOFTWARE !!NEW ADDRESS!! (Address actually changed a while ago but
was not mentioned in the Fanzine)
Download the shareware version of their SVGA library from their site.
- PCGPE (PC Games Programmer's Encyclopedia)
This is a very good set of text files which contain details on file formats
such as WAV, BMP, and GIF and techniques for making a Doom-style 3D game,
plus more.
- QBASIC PROGRAMMING CORNER **NEW**
There is a lot of stuff at this site, including:
- FAQs - disable Ctrl+Break, use arrow keys, use compilers, and more
- Free libraries, source code, tools and utilities
- QBasic Programmers Web Ring
- Site of the month
- Live Chat
- Links to compilers, QBasic Message Board, FTP sites where you can
download QBasic, etc.
MORE GOOD WEBSITES AT: http://www.users.globalnet.co.uk/~dewarr/coolsite.htm
If you own or know of a good BASIC website, please let me know and I'll add it
to the list.
*** USEFUL BASIC NEWSGROUPS **************************************************
There are four BASIC newsgroups that I know of, if anyone knows of any others
please let me know:
alt.lang.basic
alt.lang.powerbasic
comp.lang.basic.misc
microsoft.public.basic.dos
-FINAL WORDS------------------------------------------------------------------
Well, it's been my first issue of the Fanzine and I hope you liked it! This
Fanzine relies on your input so if you want to submit an article or program,
or you have an idea or comment, please feel free to email
basix@dewarr.globalnet.co.uk. Thanks in advance. I am particularly keen on
hearing your views on a "Visual Basix" (see news article above) - any comments
would be appreciated.
I've had problems with word-wrapping in TextPad, so apologies if I've
inadvertently split anyone's program's long lines into short ones, especially
in the previous issues to which I added a header with the new email addresses.
I will try to rectify any problems ASAP, just tell me which issue and which
program and I will edit the file and reupload it to my site. I don't *think*
there are any split lines in this issue. Hopefully with the fanzine becoming
more HTML based we shouldn't have these problems, you will be able to download
the entire original programs without worrying about lines >80 characters.
What's in the next issue? I don't know - I haven't had any articles for issue
10 yet, so please send them in!
Thanks to the following for help with this issue:
- Judson D. McClendon for PRIMES.BAS
- Byron Smith for the new Font Placement routines
- Joe Lawrence for the palette routines
- Luke Chao for help with the Mouse Programming article
- Pete Cooper for being the creator of the Basix Fanzine!
Thanks for reading.
Alex Warren,
18th October 1997
