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" 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 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