1: 'ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ 2: 'ﾳ QPlasma 1.0 Copyright (C) Michael Teator, 1994. All rights reserved. ﾳ 3: 'ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵ 4: 'ﾳ ÖÄÄÄÄĿ ÒÄĿ Ò ÖÄĿ ÖĿ ÖÄÒĿ ÖÄĿ ķ ÖÄĿ ﾳ 5: 'ﾳ ﾺ ﾳ ÇÄÄÙ ﾺ ÇÄĴ ÓĿ ﾺ ﾺ ﾳ ÇÄĴ ﾺ ﾺ ﾳ ﾳ 6: 'ﾳ ﾺ ﾳ Ð ÐÄÄÙ Ð Á ÓÄÄÙ Ð Ð Á Ð Á ÄÐÄ o ÓÄÄÙ ﾳ 7: 'ﾳ ﾺ ﾳ ﾳ 8: 'ﾳ ÓÄÄÄÅÄÙ Press Shift F5 to start ﾳ 9: 'ﾳ ﾳ 10: 'ﾳ Control keys during program: ﾳ 11: 'ﾳ Up, down arrows: Changes the factor used in calculating the ﾳ 12: 'ﾳ pixels color. The greater the factor, the ﾳ 13: 'ﾳ more subtle the colore change will be. ﾳ 14: 'ﾳ Left, right arrows: Changes the palette. ﾳ 15: 'ﾳ Delete: Clear the screen. ﾳ 16: 'ﾳ ESC: Exit program. ﾳ 17: 'ﾳ ﾳ 18: 'ﾳ Some notes: ﾳ 19: 'ﾳ Play with the color factor some. Some of the palettes look great ﾳ 20: 'ﾳ with a low factor while others look better with a high factor. ﾳ 21: 'ﾳ Have fun! ﾳ 22: 'ﾳ ﾳ 23: 'ﾳ Please try my other QBasic graphics demos available on AOL: ﾳ 24: 'ﾳ Bouncer: Interesting bouncing 256 color 3-D boxes ﾳ 25: 'ﾳ StarField: Nice hi-res 3-D starfield ﾳ 26: 'ﾳ There may be others, I'm always coming out with something new. ﾳ 27: 'ﾳ ﾳ 28: 'ﾳ Coming Soon: ﾳ 29: 'ﾳ QStar: Delay vectors, starfields, and 3-D tunnels (real time!) ﾳ 30: 'ﾳ QTris: 256 color tetris with photorealistic raytraced backgrounds. ﾳ 31: 'ﾳ QPadel: 3-D paddleball game ﾳ 32: 'ﾳ QWindows 95: GUI operating system wil OLE 2.0, multimedia support, ﾳ 33: 'ﾳ multitasking and multithreading. ( joke ) ﾳ 34: 'ﾳ ﾳ 35: 'ﾳ As usual these and all my QBasic programs are free of charge. Feel ﾳ 36: 'ﾳ free to borrow ideas (not code) from my programs. Please remember ﾳ 37: 'ﾳ that programmers work hard on their code. I would appreciate it VERY ﾳ 38: 'ﾳ much if you would send me a postcard with a picture of your city or ﾳ 39: 'ﾳ state on it. I'll send you a disk with lots of stuff if you send me ﾳ 40: 'ﾳ 5 dollars (postage, disks, and mailers aren't free), and I'll keep ﾳ 41: 'ﾳ your name around for when I release some of the shareware that I'm ﾳ 42: 'ﾳ working on so you will get a discount. I'm programming them in ﾳ 43: 'ﾳ object-oriented C++ (great!) Any details right now are TOP SECRET! ﾳ 44: 'ﾳ ﾳ 45: 'ﾳ You can reach me at: ﾳ 46: 'ﾳ e-mail: skream@aol.com ﾳ 47: 'ﾳ ﾳ 48: 'ﾳ us-mail: Michael Teator ﾳ 49: 'ﾳ 4 Widgeon Court ﾳ 50: 'ﾳ Bloomingdale Ga, 31302 ﾳ 51: 'ﾳ USA ﾳ 52: 'ﾳ ﾳ 53: 'ﾳ Legal Stuff: ﾳ 54: 'ﾳ In no way are any guaranties or warranties implied in this text ﾳ 55: 'ﾳ and if by some mishap or otherwise your computer blows up don't ﾳ 56: 'ﾳ come knocking on my door cause it wasn't my fault. ﾳ 57: 'ﾳ ﾳ 58: 'ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ; 59: 60: DEFINT A-Z ' Set default variable to integer for speed 61: 62: DECLARE SUB ChangeVariables (Direction%) 63: DECLARE SUB PrintErr (ErrNum) 64: DECLARE SUB Initialize () 65: DECLARE SUB Main () 66: DECLARE SUB Quit () 67: 68: CONST RaiseFactor = 1, LowerFactor = 2, UpPalette = 3, DownPalette = 4 69: CONST MaxPals = 25 70: 71: DIM SHARED Factor, PalFile AS STRING, NumPals 72: DIM SHARED Pal(255, MaxPals) AS LONG 73: 74: 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ The program! ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ 75: 76: Initialize 77: Main 78: Quit 79: 80: 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Various traps ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ 81: 82: UpPal: ' Change up one palette 83: ChangeVariables UpPalette 84: RETURN 85: 86: DownPal: ' Change down one palette 87: ChangeVariables DownPalette 88: RETURN 89: 90: UpFactor: ' Raise the factor by one 91: ChangeVariables RaiseFactor 92: RETURN 93: 94: DownFactor: ' Lower the factor by one 95: ChangeVariables LowerFactor 96: RETURN 97: 98: ClearScreen: ' Clear the screen 99: LINE (0, 10)-(319, 199), 0, BF 100: RETURN 101: 102: ErrorTrap: ' Error trap 103: PrintErr ERR 104: RESUME NEXT 105: 106: 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Program Data ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ 107: 108: PaletteFiles: 109: DATA 10 110: DATA "purple2.pal", "red.pal", "blue.pal", "green.pal", "brown.pal" 111: DATA "purple.pal", "yellow.pal","plasma.pal","neon.pal", "chroma.pal" 112: 113: 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ 114: 115: SUB ChangeVariables (Direction) STATIC 116: 117: ' Sub to change palettes and factor variables 118: ' Note: PalNum is intialized to zero by QBasic the first time this Sub is 119: ' executed. PalNum keeps its value until the next time the Sub is executed 120: ' because the Sub is declared as static. 121: 122: SELECT CASE Direction 123: CASE UpPalette 124: IF PalNum < (NumPals - 1) THEN ' Only change the palette 125: PalNum = PalNum + 1 ' if there is a another 126: PALETTE USING Pal(0, PalNum) ' palette, otherwise 127: ELSE ' make a sound. 128: SOUND 50, .5 129: END IF 130: CASE DownPalette ' Ditto 131: IF PalNum > 0 THEN 132: PalNum = PalNum - 1 133: PALETTE USING Pal(0, PalNum) 134: ELSE 135: SOUND 50, .5 136: END IF 137: CASE RaiseFactor ' Change the factor 138: IF Factor < 10 THEN ' if its within range, 139: Factor = Factor + 1 ' otherwise make a 140: ELSE ' sound. 141: SOUND 50, .5 142: END IF 143: CASE LowerFactor ' Ditto 144: IF Factor > 1 THEN 145: Factor = Factor - 1 146: ELSE 147: SOUND 50, .5 148: END IF 149: END SELECT 150: 151: END SUB 152: 153: SUB Initialize 154: 155: ON ERROR GOTO ErrorTrap ' Set errortrap 156: 157: RANDOMIZE TIMER ' Seed RND() with the timer value 158: 159: KEY 15, CHR$(160) + "K" ' Left arrow 160: KEY 16, CHR$(160) + "M" ' Right arrow 161: KEY 17, CHR$(160) + "H" ' Up arrow 162: KEY 18, CHR$(160) + "P" ' Down arrow 163: KEY 19, CHR$(160) + "S" ' Delete key 164: 165: ON KEY(15) GOSUB DownPal ' Set event trapping for the 166: ON KEY(16) GOSUB UpPal ' keys 167: ON KEY(17) GOSUB UpFactor 168: ON KEY(18) GOSUB DownFactor 169: ON KEY(19) GOSUB ClearScreen 170: 171: KEY(15) ON ' Turn on the keys 172: KEY(16) ON 173: KEY(17) ON 174: KEY(18) ON 175: KEY(19) ON 176: 177: SCREEN 13 ' Set the screen to 320x200x256 VGA 178: 179: 180: 181: RESTORE PaletteFiles ' Load each palette into the Pal() array 182: DIM Byte AS STRING * 1 183: 184: PalNumber = 0 185: READ NumPals 186: DO 187: READ PalFile ' Read a filename from the data 188: OPEN PalFile FOR BINARY AS #1 ' Open the file 189: SELECT CASE LOF(1) ' Determine what to so based on the length of file 190: CASE 768 ' If the file is 768 bytes, its probably the right file 191: 192: FOR Index = 0 TO 255 ' Load each RGB value ( write me for tech info ) 193: GET #1, , Byte: Red = ASC(Byte) 194: GET #1, , Byte: Green = ASC(Byte) 195: GET #1, , Byte: Blue = ASC(Byte) 196: Pal(Index, PalNumber) = Red + Green * &H100 + Blue * &H10000 197: NEXT 198: Pal(255, PalNumber) = &H3F3F3F ' Set color 255 to white for text & stuff 199: CLOSE #1 200: PalNumber = PalNumber + 1 201: CASE 0 ' File has no length, didn't exist 202: CLOSE #1 203: KILL PalFile 204: ERROR 53 205: CASE ELSE ' File wasn't the right length 206: CLOSE #1 207: ERROR 100 208: END SELECT 209: LOOP UNTIL PalNumber = NumPals 210: 211: PALETTE USING Pal(0, 0) ' Change the palette to the first one 212: 213: CLS 214: 215: FOR Clr = 0 TO 255 ' Draw the palette bar 216: LINE (Clr, 0)-(Clr, 9), Clr 217: NEXT 218: 219: LINE (260, 0)-(319, 9), 1, BF ' Draw the current color Box 220: LINE (260, 0)-(319, 9), 255, B 221: 222: END SUB 223: 224: SUB Main 225: 226: x = 159: y = 99: Clr = 0: Factor = 3 ' Initialize variables 227: 228: DO 229: 230: LINE (Clr, 0)-(Clr, 9), 255 ' Draw a white line at the current color 231: PSET (x, y), Clr ' Draw a pixel 232: PAINT (261, 1), Clr, 255 ' Fill current color box 233: 234: SELECT CASE INT(RND * 4) + 1 ' Pick a random direction to move 235: CASE 1: IF x > 1 THEN x = x - 1 236: CASE 2: IF y < 198 THEN y = y + 1 237: CASE 3: IF y > 11 THEN y = y - 1 238: CASE 4: IF x < 318 THEN x = x + 1 239: END SELECT 240: 241: Factor = 2 242: Pixel = POINT(x, y) ' Get the color for the 243: PixelLeft = POINT(x - 1, y) * Factor ' pixel and the pixels 244: PixelUp = POINT(x, y - 1) * Factor ' around it 245: PixelRight = POINT(x + 1, y) * Factor 246: PixelDown = POINT(x, y + 1) * Factor 247: 248: LINE (Clr, 0)-(Clr, 9), Clr ' Erase the old line on the palette bar 249: 250: ' Figure the new color with my formula 251: Clr = (254 + Pixel + PixelLeft + PixelUp + PixelRight + PixelDown) \ (Factor * 4 + 2) 252: 253: LOOP UNTIL INKEY$ = CHR$(27) ' Loop this sucker till you press ESC 254: 255: END SUB 256: 257: SUB PrintErr (ErrNum) 258: 259: SELECT CASE ErrNum ' Print the error message 260: CASE 5 261: PRINT : PRINT "Sorry, I couldn't initialize VGA graphics on your computer." 262: SYSTEM 263: CASE 53 264: PRINT : PRINT 265: PRINT "Could not open "; PalFile 266: NumPals = NumPals - 1 267: CASE 100 268: PRINT : PRINT 269: PRINT PalFile; " is not a valid PAL file." 270: NumPals = NumPals - 1 271: CASE ELSE 272: PRINT : PRINT "Error number"; ErrNum; "occured" 273: SYSTEM 274: END SELECT 275: 276: END SUB 277: 278: SUB Quit 279: 280: SCREEN 0: WIDTH 80 ' Clean up the screen 281: PRINT "Ok, you can stop staring mindlessly at the screen now!" 282: SYSTEM 283: 284: END SUB 285: |