'=========================================================================== ' Subject: QSTAR Date: 11-06-94 (12:11) ' Author: Michael Teator Code: QB, QBasic, PDS ' Origin: mhscards@aol.com Packet: GRAPHICS.ABC '=========================================================================== ' Press SHIFT-F5 to start ' ' ' Sorry that most of this code is cryptc or messy. Most of it was written ' as 2:00 in the morning. Most of this was actually written back in may of ' 94, I'm just now getting around to releasing it. There's not musch for ' internal comments in this thing, its not very elegant code anyway. I don't ' really suggest for anyone to learn by looking at this. If you want to see ' some very well written code to learn from, look for some of my other creations ' like: QPlasma - 256 color plasma generator: Has very well written code, ' I commented the heck out of it. Get this if you want to ' see some really nice pallete manipulation. ' StarField - Simple 3-D starfield - Good for starters ' ' coming soon : QTris - 256 color tetris with raytraced (wow!) backgrounds. ' NEVER before has a QBasic game accomplished what ' QTris will ' QDraw - 256 color drawing program, uses my new file format ' that I'll introduce with QTris. Also can load GIF's ' and QPlasma style palette files. Mouse support too! ' ' If any of you want to see my Path Generator that I used for the 3-D tunnel, ' write me at Skream@aol.com and I'll upload it. DEFINT A-Z DECLARE FUNCTION ComputerType () DECLARE SUB Fade (ty, tx, text$) DEF FNMove (xp%, yp%, xr%, yr%, n%, vstop%) ul = yr: ll = xr: bl = vstop - yr: rl = 319 - xr SELECT CASE n CASE 1 IF yp > ul THEN IF xp > ll THEN FNMove = 1 ELSE FNMove = 2 ELSE IF xp > ll THEN FNMove = 4 ELSE FNMove = 3 CASE 2 IF yp > ul THEN IF xp < rl THEN FNMove = 2 ELSE FNMove = 1 ELSE IF xp < rl THEN FNMove = 3 ELSE FNMove = 4 CASE 3 IF yp < bl THEN IF xp < rl THEN FNMove = 3 ELSE FNMove = 4 ELSE IF xp < rl THEN FNMove = 2 ELSE FNMove = 1 CASE 4 IF yp < bl THEN IF xp > ll THEN FNMove = 4 ELSE FNMove = 3 ELSE IF xp > ll THEN FNMove = 1 ELSE FNMove = 2 END SELECT END DEF OPTION BASE 1 RANDOMIZE TIMER DIM SHARED ScrollDelay ScrollDelay = ComputerType SCREEN 7, , 0 Fade 9, 17, "QStar!" Fade 10, 12, "by Michael Teator" Fade 12, 7, "Please wait... initializing." Stars = 100 NumBoxes = 4 Dist = 5 LineClr = 9 DelayClr = LineClr - 8 Grid3DClr = 5 Counter = 1 NumDelayVectors = 8 NumCircles = 20 DIM ReflTxt#(124) DIM BoxXradius(NumBoxes), BoxYradius(NumBoxes), BoxX(NumBoxes), BoxY(NumBoxes), BoxDir(NumBoxes), BoxClr(NumBoxes) DIM StarX(Stars), StarY(Stars), StarSpeed(Stars), StarClr(Stars) DIM LineX(2), LineY(2), LineDir(2), DelayVector(4 * NumDelayVectors) DIM Colors(4) DIM ForeCircles(3 * NumCircles), CircleR(NumCircles * 3 + 1) RESTORE TubeData READ NumFrames DIM CircleX(NumFrames), CircleY(NumFrames), CircleC(NumFrames) FOR num = 1 TO NumFrames READ CircleX(num), CircleY(num) NEXT FOR num = 1 TO NumFrames clr = INT(RND * 2) + 1 IF clr = 1 THEN CircleC(num) = 9 ELSE CircleC(num) = 1 NEXT CircleR(1) = 40 FOR num = 1 TO NumCircles * 3 STEP 3 CircleR(num + 1) = num ^ (3 / 2) / 2 + CircleR(1) NEXT RESTORE Colors FOR num = 1 TO 4 READ Colors(num) NEXT PickClr = 1 BoxCount = 1 DO BoxClr(BoxCount) = Colors(PickClr) IF PickClr < 4 THEN PickClr = PickClr + 1 ELSE PickClr = 1 BoxCount = BoxCount + 1 LOOP UNTIL BoxCount > NumBoxes LineX(1) = 62 LineY(1) = 53 LineX(2) = 120 LineY(2) = 198 LineDir(1) = 1 LineDir(2) = 2 FOR num = 1 TO Stars StarPlane = INT(RND * 4) + 1 SELECT CASE StarPlane CASE 1 StarSpeed(num) = 8 StarClr(num) = 15 StarX(num) = INT(RND * 319) StarY(num) = INT(RND * 199) CASE 2 StarSpeed(num) = 5 StarClr(num) = 7 StarX(num) = INT(RND * 319) StarY(num) = INT(RND * 181) CASE 3 StarSpeed(num) = 3 StarClr(num) = 7 StarX(num) = INT(RND * 319) StarY(num) = INT(RND * 163) CASE 4 StarSpeed(num) = 1 StarClr(num) = 8 StarX(num) = INT(RND * 319) StarY(num) = INT(RND * 144) END SELECT NEXT FOR num = 1 TO NumBoxes BoxXradius(num) = INT(RND * 20) + 1 BoxYradius(num) = INT(RND * 20) + 1 BoxX(num) = INT(RND * (319 - BoxXradius(num) * 2)) + BoxXradius(num) BoxY(num) = INT(RND * (158 + num * 4 - BoxYradius(num) * 2)) + BoxYradius(num) BoxDir(num) = INT(RND * 4) + 1 NEXT RESTORE Scroller DO READ ScrollTxt$ Scroller$ = Scroller$ + ScrollTxt$ LOOP UNTIL ScrollTxt$ = "" Scroller$ = SPACE$(30) + Scroller$ TxtLength = LEN(Scroller$) + 1 FOR Frames = 2 TO 6 SCREEN , , Frames, 0 SELECT CASE Frames CASE 2: RESTORE Grid3DFrame2 CASE 3: RESTORE Grid3DFrame3 CASE 4: RESTORE Grid3DFrame4 CASE 5: RESTORE Grid3DFrame5 CASE 6: RESTORE Grid3DFrame6 END SELECT FOR Grid3DLine = 1 TO 8 READ x1!, y1!, x2!, y2! LINE (x1!, y1!)-(x2!, y2!), Grid3DClr NEXT RESTORE Grid3DCommons FOR Grid3DLine = 1 TO 15 READ x1, y1, x2, y2 LINE (x1, y1)-(x2, y2), Grid3DClr NEXT NEXT SCREEN , , 1, 0 RESTORE Grid3DFrame1 FOR Grid3DLine = 1 TO 6 READ x1, y1, x2, y2 LINE (x1, y1)-(x2, y2), Grid3DClr PCOPY 1, 0 NEXT RESTORE Grid3DCommons FOR Grid3DLine = 1 TO 15 READ x1, y1, x2, y2 LINE (x1, y1)-(x2, y2), Grid3DClr PCOPY 1, 0 NEXT SCREEN , , 0 LOCATE 12, 18: COLOR 10: PRINT "READY!" SLEEP 1 DO SCREEN , , 7, 0 PCOPY 1, 7 IF Counter < TxtLength THEN LOCATE 18, 5: COLOR 4: PRINT MID$(Scroller$, Counter, 30) TopLine = 136 BotRefl = 151 DO GET (32, TopLine)-(270, TopLine), ReflTxt# PUT (32, BotRefl), ReflTxt#, XOR TopLine = TopLine + 1 BotRefl = BotRefl - 1 LOOP UNTIL TopLine = 143 IF counter2 = ScrollDelay THEN counter2 = 0: Counter = Counter + 1 ELSE counter2 = counter2 + 1 ELSE GOTO Part2 END IF FOR NumStars = 1 TO Stars StarX(NumStars) = StarX(NumStars) - StarSpeed(NumStars) IF StarX(NumStars) < 0 THEN StarX(NumStars) = 319 SELECT CASE StarSpeed(NumStars) CASE 8 StarY(NumStars) = INT(RND * 199) CASE 5 StarY(NumStars) = INT(RND * 181) CASE 3 StarY(NumStars) = INT(RND * 163) CASE 1 StarY(NumStars) = INT(RND * 144) END SELECT END IF PSET (StarX(NumStars), StarY(NumStars)), StarClr(NumStars) NEXT FOR num = 1 TO NumBoxes LINE (BoxX(num) - BoxXradius(num), BoxY(num) - BoxYradius(num))-(BoxX(num) + BoxXradius(num), BoxY(num) + BoxYradius(num)), BoxClr(num), B BoxDir(num) = FNMove(BoxX(num), BoxY(num), BoxXradius(num), BoxYradius(num), BoxDir(num), 158 + num * 4) SELECT CASE BoxDir(num) CASE 4: BoxY(num) = BoxY(num) + 1: BoxX(num) = BoxX(num) - 1 CASE 1: BoxY(num) = BoxY(num) - 1: BoxX(num) = BoxX(num) - 1 CASE 3: BoxY(num) = BoxY(num) + 1: BoxX(num) = BoxX(num) + 1 CASE 2: BoxY(num) = BoxY(num) - 1: BoxX(num) = BoxX(num) + 1 END SELECT NEXT FOR Delays = 1 TO NumDelayVectors * 4 STEP 4 LINE (DelayVector(Delays), DelayVector(Delays + 1))-(DelayVector(Delays + 2), DelayVector(Delays + 3)), DelayClr NEXT FOR num = 1 TO 2 LineDir(num) = FNMove(LineX(num), LineY(num), 0, 0, LineDir(num), 199) SELECT CASE LineDir(num) CASE 4: LineY(num) = LineY(num) + Dist: LineX(num) = LineX(num) - Dist CASE 1: LineY(num) = LineY(num) - Dist: LineX(num) = LineX(num) - Dist CASE 3: LineY(num) = LineY(num) + Dist: LineX(num) = LineX(num) + Dist CASE 2: LineY(num) = LineY(num) - Dist: LineX(num) = LineX(num) + Dist END SELECT NEXT LINE (LineX(1), LineY(1))-(LineX(2), LineY(2)), LineClr FOR Shift = NumDelayVectors * 4 TO 8 STEP -4 DelayVector(Shift) = DelayVector(Shift - 4) DelayVector(Shift - 1) = DelayVector(Shift - 5) DelayVector(Shift - 2) = DelayVector(Shift - 6) DelayVector(Shift - 3) = DelayVector(Shift - 7) NEXT DelayVector(1) = LineX(1) DelayVector(2) = LineY(1) DelayVector(3) = LineX(2) DelayVector(4) = LineY(2) PCOPY 7, 0 SCREEN , , 0, 0 LOOP Part2: FrameCounter = 1 FOR FrameNum = 1 TO NumFrames SCREEN , , 7, 0 PCOPY FrameCounter, 7 FrameCounter = FrameCounter + 1 IF FrameCounter > 6 THEN FrameCounter = 1 CIRCLE (CircleX(FrameNum), CircleY(FrameNum)), CircleR(1), CircleC(FrameNum) CountEm = NumCircles + 1 FOR Tube = 1 TO NumCircles * 3 STEP 3 CountEm = CountEm - 1 IF ForeCircles(Tube) <> 0 THEN AdjCircleX = CINT((ForeCircles(Tube) * CountEm * 2 + 160) / (CountEm * 2 + 1)) AdjCircleY = CINT((ForeCircles(Tube + 1) * CountEm * 2 + 99) / (CountEm * 2 + 1)) CIRCLE (AdjCircleX, AdjCircleY), CircleR(Tube + 1), ForeCircles(Tube + 2) END IF NEXT FOR Shift = NumCircles * 3 TO 6 STEP -3 ForeCircles(Shift) = ForeCircles(Shift - 3) ForeCircles(Shift - 1) = ForeCircles(Shift - 4) ForeCircles(Shift - 2) = ForeCircles(Shift - 5) NEXT ForeCircles(1) = CircleX(FrameNum) ForeCircles(2) = CircleY(FrameNum) ForeCircles(3) = CircleC(FrameNum) PCOPY 7, 0 SCREEN , , 0, 0 NEXT SCREEN 0 WIDTH 80 LOCATE 1, 1 RESTORE Logo FOR lines = 1 TO 20 READ OneLine$ Fade lines, 1, OneLine$ NEXT LOCATE 22 DO: LOOP UNTIL INKEY$ <> "" SYSTEM Scroller: DATA "Hi! Welcome to QStar! Like the graphics? " DATA "Someone told me this was impossible with QBasic... " DATA "guess my poor friend was wrong! " DATA "This is 320x200x16 graphics and runs at 30fps on a fast 486. " DATA "Write me and tell me what you think! " DATA "America Online: Skream. " DATA "Internet: skream@aol.com " DATA "Next demo: Flying into the starfield and some other tricks! " DATA "Code by Skream. Later... :) " DATA "" Grid3DFrame1: DATA 0,144,319,144, 0,146,319,146, 0,151,319,151, 0,160,319,160 DATA 0,175,319,175, 0,199,319,199, 0,199,319,199, 0,199,319,199 Grid3DFrame2: DATA 0,144,319,144, 0,145,319,145, 0,146,319,146, 0,152,319,152 DATA 0,162,319,162, 0,178,319,178, 0,199,319,199, 0,199,319,199 Grid3DFrame3: DATA 0,144,319,144, 0,145,319,145, 0,147,319,147, 0,153,319,153 DATA 0,164,319,164, 0,182,319,182, 0,199,319,199, 0,199,319,199 Grid3DFrame4: DATA 0,144,319,144, 0,146,319,146, 0,148,319,148, 0,154,319,154 DATA 0,166,319,166, 0,186,319,186, 0,199,319,199, 0,199,319,199 Grid3DFrame5: DATA 0,144,319,144, 0,146,319,146, 0,149,319,149, 0,156,319,156 DATA 0,169,319,169, 0,190,319,190, 0,199,319,199, 0,199,319,199 Grid3DFrame6: DATA 0,144,319,144, 0,145,319,145, 0,147,319,147, 0,150,319,150 DATA 0,158,319,158, 0,172,319,172, 0,194,319,194, 0,199,319,199 Grid3DCommons: DATA 280,144,319,153, 200,144,225,199, 220,144,275,199, 240,144,319,189 DATA 260,144,319,167, 300,144,319,147, 140,144,130,199, 120,144, 95,199 DATA 100,144, 45,199, 80,144, 0,189, 60,144, 0,167, 40,144, 0,153 DATA 20,144, 0,147, 160,144,160,199, 180,144,190,199 Colors: DATA 10,11,12,14 Logo: DATA "旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 DATA "� � � � � � . � � . � DATA "뇌 栢栢栢芳 栢� 栢� 栢栢栢� .栢栢栢芳 栢栢芳. 栢芳 栢芳 栢� . � � DATA "� � 栢�袴袴술栢� 栢�� 栢�袴栢� 栢�袴袴� 栢�袴栢� 栢栢� 栢栢� 栢� � DATA "� 栢栢栢芳 栢栢排� 栢栢栢�� 栢栢芳 炫栢栢栢� 栢�栢栢�栢� 栢� � � DATA "� � 훤袴谷舫 栢�谷芳 栢�袴栢� 栢�袴�. 栢�袴栢� 栢뵌栢�송舫 훤� � � DATA "� 栢栢栢舫 栢� 栢� 栢� 炫舫 栢栢栢芳 栢� 栢� 栢�.훤� 栢� 栢� � � DATA "� � 훤袴袴暠 훤� 훤�.훤� 훤� 훤袴袴暠 훤�. 훤�.훤� � 훤� 훤� � � DATA "� . � � . � � � � � DATA "� � 靈컴컴� 爐� .靈커 靈� 켠� 靈커 爐커 爐커 靈爐� 靈커 靈� � � DATA "뇌 � � � 픔좆 픔캑. 聃� � � � � � 픔 � � � � � 邂 聃� � � DATA "� � � � � 懃켸 � � 聃켸 켕� 聃켸 懃켸 懃켸 � � � 聃켸 聃켸 � DATA "� � � � write to: � � . � � DATA "뇌 聃컴탠� skream@aol.com . � � � DATA "� � � � � � � � � DATA "� � � See ya later... � � � DATA "� Look for more demos soon! � � � DATA "� � � This has been a presentation of Skream! design � � � DATA "읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 DATA " press a key . . . TubeData: ' Data created by Path Generator Version 1.0 ' by Michael Teator in May 1994 ' Comment: This one should look great! -Skream ' Date: 05-24-1994 Time: 08:32:11 ' Number of points DATA 474 ' ------ Path data ------ DATA 159,99,159,99,159,99,159,99,159,99,159,99,159,99,158,100,157,100,156,101,154,102,153,103,152,105,149,107,147,108,145,110,144,112,139,114,136,116,130,119 DATA 122,122,116,125,108,128,101,132,92,136,83,139,75,142,67,145,57,146,47,146,40,147,38,147,45,146,53,146,59,145,69,142,82,138,95,134,114,127,130,121 DATA 148,113,162,103,171,97,185,88,196,81,209,74,220,66,230,61,242,54,252,48,264,42,270,36,267,38,261,43,256,48,250,53,240,60,230,68,218,75,209,82 DATA 198,88,188,93,177,96,164,99,151,101,139,102,126,102,113,102,104,102,89,102,78,101,66,101,51,101,40,101,29,101,19,101,26,101,42,101,57,101,71,100 DATA 90,98,100,98,110,97,124,97,140,97,158,99,177,102,190,105,206,111,216,116,228,122,238,129,251,136,264,144,276,152,281,154,285,157,269,157,256,155,240,152 DATA 221,148,205,142,185,135,163,129,150,126,136,122,119,119,106,117,94,115,80,115,69,116,55,119,51,121,53,127,60,128,75,128,89,128,108,127,129,126,144,124 DATA 160,122,172,121,189,118,212,117,224,116,236,113,249,108,257,103,264,97,269,87,269,78,267,76,260,81,254,90,250,96,242,103,234,110,225,115,212,120,200,125 DATA 188,129,173,133,159,135,139,135,128,134,128,132,136,130,149,130,165,130,182,128,197,123,209,118,225,110,237,103,245,97,254,90,263,82,266,78,262,91,257,98 DATA 247,103,232,108,218,111,206,115,196,117,185,115,172,110,164,104,154,95,144,85,134,76,123,65,113,58,100,53,84,48,74,48,62,48,52,51,47,57,42,66 DATA 41,70,44,75,51,78,60,76,69,71,78,65,86,59,94,54,103,49,114,45,128,44,142,46,150,50,156,56,158,64,161,74,163,84,163,96,163,108,163,116 DATA 164,126,166,138,167,146,170,152,178,161,188,164,190,160,186,155,181,153,173,151,168,142,165,130,165,116,165,100,164,83,164,68,164,54,162,40,162,36,160,44 DATA 159,58,158,72,158,89,158,102,158,117,158,129,159,140,159,153,158,162,158,169,159,167,164,158,167,144,167,129,167,115,168,96,168,85,168,68,168,52,166,40 DATA 164,32,161,31,158,41,157,52,157,66,158,82,158,98,159,113,158,127,158,138,158,147,156,156,155,160,152,162,148,160,143,156,135,146,127,137,117,122,108,108 DATA 99,93,91,79,82,66,75,59,68,55,59,48,47,40,52,47,60,53,73,59,86,68,103,80,117,90,132,98,144,105,162,114,183,123,198,130,218,140,232,146 DATA 250,154,272,161,280,162,284,156,279,150,268,145,252,139,236,132,227,129,213,125,205,116,199,100,198,79,198,64,200,52,202,43,207,36,208,41,207,53,203,67 DATA 196,86,188,95,178,104,169,110,159,116,146,122,135,128,124,137,114,144,105,150,92,155,82,156,66,157,63,156,75,154,85,152,96,149,108,144,118,139,128,132 DATA 138,124,146,113,148,101,142,92,133,89,123,90,109,93,92,94,78,95,61,95,48,94,41,92,42,85,49,78,57,72,71,63,86,55,105,47,119,44,133,42 DATA 152,41,170,41,188,42,208,46,224,51,236,57,249,65,258,76,265,89,266,99,266,112,263,126,257,138,250,147,240,155,231,158,223,160,214,161,201,160,188,156 DATA 175,149,165,140,160,132,150,118,141,107,130,99,116,98,111,105,111,113,116,120,124,127,134,137,146,144,160,147,176,146,190,141,199,131,205,119,205,105,202,93 DATA 191,81,186,79,181,87,175,100,169,110,161,124,155,138,149,148,144,153,147,150,155,137,166,124,176,113,183,97,187,83,188,69,186,53,182,44,181,53,183,67 DATA 186,75,192,86,204,94,224,99,238,100,256,99,272,94,288,91,294,88,285,90,270,95,252,98,239,100,226,103,206,106,181,106,156,106,137,107,122,107,113,106 DATA 94,108,82,109,75,110,86,112,103,111,124,109,145,107,172,102,194,97,210,90,220,83,237,70,245,64,244,74,232,90,218,103,206,111,189,115,171,117,154,112 DATA 141,103,136,88,136,66,136,55,137,47,135,56,133,70,125,81,112,87,92,91,87,85,97,76,109,76,119,85,123,100,124,113,126,124,131,127,143,125,152,118 DATA 156,112,159,107,162,103,163,100,164,100,166,99,167,99,168,99,169,99,169,99,169,99,169,99,169,99,169,99 FUNCTION ComputerType CLS PRINT "Welcome to QStar!" PRINT PRINT "Please select the speed computer you are using:" PRINT " (1) 286" PRINT " (2) Slow 386" PRINT " (3) Fast 386 or slow 486" PRINT " (4) Fast 486" PRINT " (5) Pentium" PRINT : PRINT PRINT "Please note that these settings only affect the scroller." DO selection$ = INKEY$ SELECT CASE selection$ CASE "1" TO "5" ComputerType = VAL(selection$) - 1 EXIT FUNCTION END SELECT LOOP END FUNCTION SUB Fade (ty, tx, text$) LOCATE ty, tx: COLOR 8: PRINT text$ FOR n = 1 TO (ScrollDelay * 5000): NEXT LOCATE ty, tx: COLOR 7: PRINT text$ FOR n = 1 TO (ScrollDelay * 5000): NEXT LOCATE ty, tx: COLOR 15: PRINT text$ FOR n = 1 TO (ScrollDelay * 5000): NEXT END SUB