1: DECLARE FUNCTION Speed! (acc!) 2: DECLARE SUB PlyBck () 3: 'Hello If you find this program usefull please let me know. I'm a 13 year old 4: 'That lives in AZ, I didn't see any kind of 3d Qbasic modler out there so 5: 'here one is. I am trying to get shading, but that is incredibly difficult. 6: 'If anyone out there does it before me please send me your Qbasic program. 7: 'I would like to see how you did it. My AOL address is Coyles, or 8: 'for you non-AOLers its coyles@AOL.com. I would really like so feedback. 9: ' THNX for reading. 10: '=========================================================================== 11: ' 12: 'Edited by Roy Keene & James Lampton for better coloring & the saving 13: 'playback function. 14: ' 15: DECLARE SUB drawit () 16: DECLARE SUB plotit () 17: DECLARE SUB ms () 18: DECLARE SUB PAUSE () 19: DECLARE SUB mousestatus (lb%, rb%, XMouse%, YMouse%) 20: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%) 21: DECLARE SUB MousePut (x%, y%) 22: DECLARE SUB MouseHide () 23: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 24: DECLARE SUB mouseshow () 25: DECLARE FUNCTION MouseInit% () 26: COMMON SHARED NODES 27: COMMON SHARED nx, ny, num 28: DIM SHARED Mouse$ 29: NODES = 2000 30: DIM SHARED nx(1 TO NODES) 31: DIM SHARED ny(1 TO NODES) 32: TYPE sammy 33: x AS INTEGER 34: y AS INTEGER 35: END TYPE 36: Mouse$ = SPACE$(57) 37: FOR i% = 1 TO 57 38: READ a$ 39: H$ = CHR$(VAL("&H" + a$)) 40: MID$(Mouse$, i%, 1) = H$ 41: NEXT i% 42: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 43: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 44: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 45: DATA 8B,5E,06,89,17,5D,CA,08,00 46: 10 CLS 47: SCREEN 12 48: DIM SHARED file$ 49: 1 LOCATE 1, 1: LINE INPUT "Metafilename-->"; file$ 50: IF file$ = "" THEN file$ = "title.3d" 51: IF file$ = "q" OR file$ = "Q" THEN END 52: OPEN file$ FOR RANDOM AS #1 LEN = NODES 53: IF LOF(1) = 0 THEN GOTO 121 ELSE PRINT "File exist!": INPUT "(O)verrite or (P)lay"; OOP$: IF LEFT$(OOP$, 1) = "o" OR LEFT$(OOP$, 1) = "O" GOTO 121 ELSE PlyBck: END 54: 121 CLOSE 1: OPEN file$ FOR OUTPUT AS #1 LEN = NODES 55: mouseshow 56: plotit 57: drawit 58: PAUSE 59: 60: SUB drawit 61: DIM fs(1 TO NODES) 62: DIM f(1 TO NODES) 63: MouseHide 64: CLS 65: steps = Speed(3) / 2 66: PRINT "Speed: "; Speed(3); "Mhz" 67: FOR gh% = 1 TO num 68: fs(gh%) = ny(gh%) / steps 69: NEXT gh% 70: 'PRINT f1; f2; f3; f4; f5; f6 71: FOR fi% = 1 TO steps * 1.75 72: FOR gh% = 1 TO num 73: f(gh%) = f(gh%) + fs(gh%) 74: NEXT gh% 75: FOR rt% = 1 TO num - 1 76: tx = nx(rt%): ty = (240 - ny(rt%)) + f(rt%) 77: tx2 = nx(rt% + 1): ty2 = (240 - ny(rt%)) + f(rt%) 78: LINE (tx, ty)-(tx2, ty2), CINT((ty2 + tx2 - tx - ty2) / 1.5) 79: NEXT rt% 80: NEXT fi% 81: END SUB 82: 83: SUB MouseDriver (ax%, bx%, cx%, dx%) 84: DEF SEG = VARSEG(Mouse$) 85: Mouse% = SADD(Mouse$) 86: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 87: END SUB 88: 89: SUB MouseHide 90: ax% = 2 91: MouseDriver ax%, 0, 0, 0 92: END SUB 93: 94: FUNCTION MouseInit% 95: ax% = 0 96: MouseDriver ax%, 0, 0, 0 97: MouseInit% = ax% 98: END FUNCTION 99: 100: SUB MousePut (x%, y%) 101: ax% = 4 102: cx% = x% 103: dx% = y% 104: MouseDriver ax%, 0, cx%, dx% 105: END SUB 106: 107: SUB MouseRange (x1%, y1%, x2%, y2%) 108: ax% = 7 109: cx% = x1% 110: dx% = x2% 111: MouseDriver ax%, 0, cx%, dx% 112: ax% = 8 113: cx% = y1% 114: dx% = y2% 115: MouseDriver ax%, 0, cx%, dx% 116: END SUB 117: 118: SUB mouseshow 119: ax% = 1 120: MouseDriver ax%, 0, 0, 0 121: END SUB 122: 123: SUB mousestatus (lb%, rb%, XMouse%, YMouse%) 124: ax% = 3 125: MouseDriver ax%, bx%, cx%, dx% 126: lb% = ((bx% AND 1) <> 0) 127: rb% = ((bx% AND 2) <> 0) 128: XMouse% = cx% 129: YMouse% = dx% 130: END SUB 131: 132: SUB PAUSE 133: 11 mousestatus lb%, rb%, x%, y% 134: IF lb% = 0 AND rb% = 0 AND INKEY$ = "" THEN GOTO 11 ELSE lb% = 0: rb% = 0: EXIT SUB 135: END SUB 136: 137: SUB plotit 138: CLS : SCREEN 12 139: MouseRange 0, 240, 640, 480 140: loops: 141: FOR yi = 1 TO 100 STEP .6: NEXT yi 142: DO 143: mousestatus lb%, rb%, x%, y% 144: IF lb% = -1 THEN GOTO spoint 145: IF rb% = -1 THEN GOTO dones 146: LOOP 147: spoint: 148: yu% = yu% + 1 149: nx(yu%) = x%: ny(yu%) = 480 - y% 150: CIRCLE (x%, y%), 2 151: WRITE #1, x%, y% 152: GOTO loops 153: dones: 154: num = yu% 155: CLOSE 1 156: END SUB 157: 158: SUB PlyBck 159: CLOSE 1 160: OPEN file$ FOR INPUT AS 1 161: MouseRange 0, 240, 640, 480 162: CLS : SCREEN 12 163: LOCATE 1, 1: PRINT "Loading & Decoding..." 164: lops: 165: FOR yi = 1 TO 100 STEP .6: NEXT yi 166: DO 167: IF nd% = 1 THEN GOTO dnes 168: GOTO pute 169: LOOP 170: pute: 171: yu% = yu% + 1 172: IF EOF(1) THEN nd% = 1 ELSE INPUT #1, x%, y% 173: nx(yu%) = x%: ny(yu%) = 480 - y% 174: CIRCLE (x%, y%), 1, 2 175: GOTO lops 176: dnes: 177: num = yu% 178: CLOSE 1 179: LOCATE 1, 1: PRINT " " 180: drawit 181: END SUB 182: 183: FUNCTION Speed (acc) 184: m = VAL("5" + STRING$(acc, "0")) 185: a = TIMER 186: FOR q = 0 TO m 187: NEXT q 188: aa = TIMER - a 189: ttl = FIX((aa) * VAL("1" + STRING$(ABS(5 - acc), "0"))) 190: Speed = ttl 191: END FUNCTION 192: |