1: DECLARE SUB MousePut (x%, y%) 2: DECLARE SUB MouseHide () 3: DECLARE SUB Render3DBox (x!, y!, wd!, ht!, vpx!, vpy!, c1!, c2!, dp!) 4: DECLARE SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%) 5: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 6: DECLARE SUB MouseShow () 7: DECLARE FUNCTION MouseInit% () 8: DIM SHARED Mouse$ 9: Mouse$ = SPACE$(57) 10: FOR I% = 1 TO 57 11: READ a$ 12: H$ = CHR$(VAL("&H" + a$)) 13: MID$(Mouse$, I%, 1) = H$ 14: NEXT I% 15: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 16: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 17: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 18: DATA 8B,5E,06,89,17,5D,CA,08,00 19: CLS 20: ms% = MouseInit% 21: IF NOT ms% THEN 22: PRINT "Mouse not found" 23: END 24: END IF 25: SCREEN 12 26: MouseShow 27: MouseHide 28: 1 MouseStatus Lb%, Rb%, y%, x% 29: a$ = UCASE$(INKEY$) 30: IF a$ = CHR$(27) OR a$ = "Q" THEN END 31: IF Rb% AND Lb% THEN 32: z = z + (StorX - x%) 33: Render3DBox PstSqY, PstSqX, 40 + PstZ, 40 + PstZ, PstY, PstX, 0, 0, 50 34: Render3DBox SqY, SqX, 40 + z, 40 + z, PstY, PstX, 15, 1, 50 35: PstZ = z 36: StorX = x% 37: END IF 38: IF Rb% AND (SqX <> x% OR SqY <> y%) THEN 39: IF LstAcc = 1 THEN MousePut CINT(PstSqY), CINT(PstSqX): x% = CINT(PstSqX): y% = CINT(PstSqY) 40: SqX = x%: SqY = y% 41: Render3DBox PstSqY, PstSqX, 40 + z, 40 + z, PstY, PstX, 0, 0, 50 42: Render3DBox SqY, SqX, 40 + z, 40 + z, PstY, PstX, 15, 1, 50 43: PstSqY = y% 44: PstSqX = x% 45: LstAcc = 2 46: StorX = x% 47: END IF 48: IF Lb% AND (PstX <> x% OR PstY <> y%) THEN 49: IF LstAcc = 2 THEN MousePut CINT(PstY), CINT(PstX): x% = CINT(PstX): y% = CINT(PstY) 50: Render3DBox SqY, SqX, 40 + z, 40 + z, PstY, PstX, 0, 0, 50 51: Render3DBox SqY, SqX, 40 + z, 40 + z, CSNG(y%), CSNG(x%), 15, 1, 50 52: PstY = y% 53: PstX = x% 54: LstAcc = 1 55: StorX = x% 56: END IF 57: GOTO 1 58: 59: SUB MouseDriver (ax%, bx%, cx%, dx%) 60: DEF SEG = VARSEG(Mouse$) 61: Mouse% = SADD(Mouse$) 62: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 63: END SUB 64: 65: SUB MouseHide 66: ax% = 2 67: MouseDriver ax%, 0, 0, 0 68: END SUB 69: 70: FUNCTION MouseInit% 71: ax% = 0 72: MouseDriver ax%, 0, 0, 0 73: MouseInit% = ax% 74: END FUNCTION 75: 76: SUB MousePut (x%, y%) 77: ax% = 4 78: cx% = x% 79: dx% = y% 80: MouseDriver ax%, 0, cx%, dx% 81: END SUB 82: 83: SUB MouseRange (x1%, y1%, x2%, y2%) 84: ax% = 7 85: cx% = x1% 86: dx% = x2% 87: MouseDriver ax%, 0, cx%, dx% 88: ax% = 8 89: cx% = y1% 90: dx% = y2% 91: MouseDriver ax%, 0, cx%, dx% 92: END SUB 93: 94: SUB MouseShow 95: ax% = 1 96: MouseDriver ax%, 0, 0, 0 97: END SUB 98: 99: SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%) 100: ax% = 3 101: MouseDriver ax%, bx%, cx%, dx% 102: Lb% = ((bx% AND 1) <> 0) 103: Rb% = ((bx% AND 2) <> 0) 104: xMouse% = cx% 105: yMouse% = dx% 106: END SUB 107: 108: SUB Render3DBox (x, y, wd, ht, vpx, vpy, c1, c2, dp) 109: LINE (x, y)-(x + wd, y + ht), c1, B 110: IF (vpx < x) OR (vpy < y) THEN LINE (x, y)-(vpx, vpy), c1 ' upper left 111: IF (vpx > x + wd) OR (vpy < y) THEN LINE (x + wd, y)-(vpx, vpy), c1 ' lower left 112: IF (vpx < x) OR (vpy > y + ht) THEN LINE (x, y + ht)-(vpx, vpy), c1 ' upper right 113: IF (vpx > x + wd) OR (vpy > y + ht) THEN LINE (x + wd, y + ht)-(vpx, vpy), c1 ' lower right 114: LINE (x + 1, y + 1)-(x + wd - 1, y + ht - 1), c2, BF ' The Front Box 115: 'LINE ' The Back Box 116: END SUB 117: 118: SUB Render3DTri (x, y, wd, ht, vpx, vpy, c1, c2, dp) 119: LINE (x, y)-(x + wd, y + ht), c1, B 120: IF (vpx < x) OR (vpy < y) THEN LINE (x, y)-(vpx, vpy), c1 ' upper left 121: IF (vpx > x + wd) OR (vpy < y) THEN LINE (x + wd, y)-(vpx, vpy), c1 ' lower left 122: IF (vpx < x) OR (vpy > y + ht) THEN LINE (x, y + ht)-(vpx, vpy), c1 ' upper right 123: IF (vpx > x + wd) OR (vpy > y + ht) THEN LINE (x + wd, y + ht)-(vpx, vpy), c1 ' lower right 124: LINE (x + 1, y + 1)-(x + wd - 1, y + ht - 1), c2, BF 125: END SUB 126: |