#COMPILE EXE #INCLUDE "\CONTOOLS\CT_STD.INC" #INCLUDE "\GFXTOOLS\GfxT_Pro.INC" DECLARE FUNCTION CircularFcn! (x!) DEFLNG A-Z GLOBAL ConsRows AS LONG GLOBAL ConsCols AS LONG GLOBAL HoleStatus() AS LONG FUNCTION WinMain(BYVAL hCurInstance AS LONG, _ BYVAL hPrevInstance AS LONG, _ lpszCmdLine AS ASCIIZ PTR, _ BYVAL nCmdShow AS LONG) _ EXPORT AS LONG DIM HoleStatus(32) AS GLOBAL LONG DIM ax(10) DIM ay(10) DIM az(10) 'First executable line ConsoleToolsAuthorize &h00000000 InitConsoleTools hCurInstance, 0, 0, 3, 0, 0 GraphicsToolsAuthorize &h00000000 ConsRows = 40 ConsCols = 102 CONSOLE SCREEN ConsRows, ConsCols 'ConsoleTitle "View Simulator 1.0" lResult& = ConsoleIcon(%IDI_Console) lResult& = DeleteWindowMenuItem(%MENUITEM_TOOLBAR) lResult& = ConsoleToolbar(%OFF, %NO_CHANGE) ConsoleWindow %SHOW ConsoleWindow %MAXIMIZE 'Landmarks ax(1) = 58: ay(1) = -10: az(1) = 0 'pitcher ax(2) = -3: ay(2) = -3: az(2) = 0 'catcher ax(3) = 73: ay(3) = 53: az(3) = 0 '1st ax(4) = 128: ay(4) = 32: az(4) = 0 '2nd ax(5) = 73: ay(5) = -63: az(5) = 0 '3rd ax(6) = 128: ay(6) = -38: az(6) = 0 'short ax(7) = 250: ay(7) = -150: az(7) = 0 'lf ax(8) = 350: ay(8) = -10: az(8) = 0 'cf ax(9) = 250: ay(9) = 150: az(9) = 0 'rf Points = 9 line input "Enter file name: "; fname$ fname$ = RTRIM$(fname$) BackgroundPic$ = fname$ GOSUB DefineBitmap StartHere: CLS PRINT "X -> Increment x x -> Decrement x" PRINT "Y -> Increment y y -> Decrement y" PRINT "Z -> Increment z z -> Decrement z" PRINT "1 -> Increment Tz 2 -> Decrement Tz" PRINT "3 -> Increment Ty 4 -> Decrement Ty" ObsX = -80 ObsY = 0 ObsZ = 50 ObsTz = -10 ObsTy = 0 GfxWindow %GFX_SHOW r = 0 c = 0 DO IF x$ = "X" THEN INCR ObsX IF x$ = "Y" THEN INCR ObsY IF x$ = "Z" THEN INCR ObsZ IF x$ = "1" THEN INCR ObsTz IF x$ = "2" THEN DECR ObsTz IF x$ = "x" THEN DECR ObsX IF x$ = "y" THEN DECR ObsY IF x$ = "z" THEN DECR ObsZ IF x$ = "3" THEN INCR ObsTy IF x$ = "4" THEN DECR ObsTy b$ = " " LOCATE 1, 65: PRINT b$; LOCATE 2, 65: PRINT b$; LOCATE 3, 65: PRINT b$; LOCATE 4, 65: PRINT b$; LOCATE 5, 65: PRINT b$; LOCATE 1, 60: PRINT "ObsX:"; ObsX; LOCATE 2, 60: PRINT "ObsY:"; ObsY; LOCATE 3, 60: PRINT "ObsZ:"; ObsZ; LOCATE 4, 60: PRINT "TilZ:"; ObsTz; LOCATE 5, 60: PRINT "TilY:"; ObsTy; 'Erase old points FOR i = 1 TO Points CALL EliminateHole(i) NEXT GfxRefresh 0 FOR i = 1 TO Points CALL GetCoordinates(ax(i), ay(i), az(i), ObsX, ObsY, ObsZ, ObsTz, ObsTy, r, c) IF r <> 0 AND c <> 0 THEN x$ = "abcdefg" IF i = 1 THEN x$ = "pitcher" IF i = 2 THEN x$ = "catcher" IF i = 3 THEN x$ = "1stbase" IF i = 4 THEN x$ = "2ndbase" IF i = 5 THEN x$ = "3rdbase" IF i = 6 THEN x$ = "shortst" IF i = 7 THEN x$ = "leftfld" IF i = 8 THEN x$ = "center" IF i = 9 THEN x$ = "right" L = LEN(x$) CALL GraphHole (i, r, c, r, c+L-1) LOCATE r, c if c+L-1 > ConsCols THEN PRINT "O"; else PRINT x$; end if END IF NEXT GfxRefresh 0 x$ = WAITKEY$ IF UCASE$(x$) = "Q" THEN EXIT DO LOOP LOCATE 1, 1: PRINT "Enter N for new coordinates, any other quit"; x$ = WAITKEY$ x$ = UCASE$(x$) GfxWindow %GFX_HIDE IF x$ = "N" THEN GOTO StartHere EXIT FUNCTION DefineBitmap: 'Define Graphics background screen ConsoleGfx 1, 6, ConsCols, ConsRows-1 GfxWindow %GFX_HIDE sFileName$ = BackgroundPic$ IF UCASE$(RIGHT$(sFileName$, 3)) = "BMP" THEN lResult = BitmapParam(sFileName$, %IMAGE_WIDTH_HEIGHT) lWidth = LOWRD(lResult) lHeight= HIWRD(lResult) lResult = StretchBitmap(sFileName$, 1024, 512) ELSE lResult = ImageParam(sFileName$, %IMAGE_WIDTH_HEIGHT) lWidth = LOWRD(lResult) lHeight= HIWRD(lResult) lResult = StretchImage(sFileName$, 1024, 512) END IF RETURN END FUNCTION SUB GetCoordinates(Wx, Wy, Wz, ox, oy, oz, ObsTz, ObsTy, r, c) xw! = .8 sfv! = ConsRows sfh! = ConsCols * .85 'screen aspect factor TiltZ! = ObsTz * .01745 'convert to radians TiltY! = ObsTy * .01745 TiltZ! = CircularFcn(TiltZ!) TiltY! = CircularFcn(TiltY!) 'Verticle (adjust row) IF (ox = Wx) AND (oy = Wy) THEN ThetaZ! = 0 ELSE ThetaZ! = ATN( (oz - Wz) / SQR( (ox - Wx)^2 + (oy - Wy)^2) ) ThetaZ! = CircularFcn(ThetaZ!) END IF ThetaZ! = CircularFcn(ThetaZ! + TiltZ!) IF ThetaZ! > 3.1416 THEN SignFac! = 1.0 ELSE SignFac! = -1.0 cv! = SignFac! * TAN(ThetaZ!) * xw! * sfv! 'Horizontal (adjust column) IF (ox = Wx) AND (oy = Wy) THEN ThetaY! = 0 ELSE ThetaY! = ATN( (oy - Wy) / SQR( (ox - Wx)^2 + (oy - Wy)^2) ) ThetaY! = CircularFcn(ThetaY!) END IF ThetaY! = CircularFcn(ThetaY! + TiltY!) IF ThetaY! > 3.1416 THEN SignFac! = 1.0 ELSE SignFac! = -1.0 ch! = SignFac! * TAN(ThetaY!) * xw! * sfh! c = (ConsCols \ 2) + ch! TotGraphRows = ConsRows - 6 'Calculate mid-row for graphics window, 'then add 5 because window starts at row 6 mr! = (TotGraphRows \ 2) + 5 r = mr! - cv! IF c < 1 THEN c = 0 IF c > ConsCols THEN c = 0 IF r < 6 THEN r = 0 IF r > ConsRows - 1 THEN r = 0 END SUB FUNCTION CircularFcn! (x!) 'INPUT IS ASSUMED IN RADIANS 'ELIMINATES MULTIPLES OF 2*PI AND RETURNS VALUE AS POSITIVE IF x! > 6.2831853071 OR x! < -6.2831853071 THEN z! = x! / 6.2831853071 Fract! = FRAC(z!) x! = Fract! * 6.2831853071 IF x! < 0 THEN x! = 6.2831853071 + x! CircularFcn! = x! ELSE CircularFcn! = x! END IF END FUNCTION SUB GraphHole (hole, row1, col1, row2, col2) if HoleStatus(hole) = -1 then EXIT SUB if col1 < 1 or col1 > ConsCols or _ col2 < 1 or col2 > ConsCols or _ row1 < 6 or row1 > ConsRows-1 or _ row2 < 6 or row2 > ConsRows-1 THEN if col1 < ConsCols and col2 > ConsCols and row2 <= ConsRows-1 THEN col2 = ConsCols else EXIT SUB end if end if res = GfxTextHole (hole, col1, row1, col2, row2) if res = 0 then HoleStatus(hole) = -1 else locate 2, 50: PRINT " Bad Hole:" + str$(hole) + " ": zz$ = WAITKEY$ end if END SUB SUB EliminateHole (hole) if HoleStatus(hole) = 0 then EXIT SUB res = FillHole (hole) if res = 0 then HoleStatus(hole) = 0 else locate 2, 50: PRINT " Bad fill:" + str$(hole) + " ": zz$ = WAITKEY$ end if END SUB