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