home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
ham
/
aprs114.zip
/
MAPFIX.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-07-09
|
14KB
|
292 lines
REM Map files must contain the string [0,Labels ] as the first text line
REM after the 0,-1 that indivates the end of all lines and start of Labels
REM This program looks for that string to wrap around to the start.
RdsOn = -1: Labls = -1
MaxUnts = 20: u = 20'Total number of units anticipated
DIM x%(1000), y%(1000)'MAP coordinates
DIM LN$(80) 'LineNames
DIM ML$(80), Mla(80), MLo(80), MLr(80) 'Map Labels, lengths and coordinates
Begin: CLS
PRINT " MAPFIX.bas PROGRAM FOR DISPLAYING APRS MAPS": PRINT
PRINT "This program allows you to look at a map file and all of its points."
PRINT "It does not allow you to change anything or modify the data points yet."
PRINT "The way to use it, is to run this MAPFIX.bas program within the Quick"
PRINT "BASIC environment and to also LOAD the associated MAP file as a DOCUMENT."
PRINT
PRINT "Then each time you run the MAPFIX program to see how your points look,"
PRINT "you can Quit the program and use the F2 key to go manipulate the data"
PRINT "points in the MAP file. Then save the latest version of your map data"
PRINT "and hit F5 to re-run the MAPFIX.bas program to see how the changes look!"
PRINT
PRINT "One feature of MAPFIX.bas is that it shows you the decimal values of the"
PRINT "cursor position which is necessary for placing map labels in the MAP file."
PRINT
PRINT
PRINT "ALSO NOTE THAT THE SIZE OF THE INTEGER ARRAYS USED IN APRS IS 1000, SO"
PRINT "You should never have more than 1000 points in your file. If you need"
PRINT "more points, begin another map."
PRINT
PRINT "HIT ENTER to continue..."; : INPUT a$
INIT: ON ERROR GOTO ErrorTrap
ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: SCREEN 9
IF ScrnType$ = "EGA" THEN COLOR 15, 0
REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
GOSUB Help: GOSUB LoadMap: Uid$ = "bruninga"
ON ERROR GOTO 0
Tags = -1: KP = 1
Usr$ = "3poscor"
COM$ = "COM1:"
Baud$ = "9600"
Port$ = "nadn"
OPEN COM$ + Baud$ + ",n,8,1,cs0,ds0,cd0" FOR RANDOM AS #1
Main: GOSUB DrawMap
DO
REM IF ScrnType$ = "EGA" THEN COLOR 15, 0 'no idea why this was here
GoAgain: LET a$ = INKEY$
IF a$ <> "" THEN
a$ = UCASE$(a$): Key$ = a$
IF a$ = "G" THEN GOSUB Grid
IF a$ = "S" THEN GOSUB Labels
IF a$ = "L" THEN Labls = NOT Labls
IF a$ = "T" THEN Tags = NOT Tags
IF a$ = "H" THEN GOSUB Help
IF a$ = "M" THEN GOSUB MapList
IF a$ = "N" THEN GOSUB NextLine: GOSUB Cursor
IF a$ = "P" THEN GOSUB Previous: GOSUB Cursor
IF a$ = "Q" THEN SYSTEM
IF a$ = " " THEN GOSUB DrawMap
IF a$ = "+" THEN Z = Z + 1: GOSUB Cursor ' moves to next map point
IF a$ = "-" THEN Z = Z - 1: GOSUB Cursor ' moves backwards
B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
IF B$ = "G" THEN CDX = CPX: CDY = CPY: GOSUB DrawMap 'Home key
IF B$ = "O" THEN CDX = LONo: CDY = LATo: GOSUB DrawMap 'End Key
IF B$ = "M" THEN CPX = CPX - 4 / (KP * ppdV): GOSUB Cursor
IF B$ = "K" THEN CPX = CPX + 4 / (KP * ppdV): GOSUB Cursor
IF B$ = "H" THEN CPY = CPY + 4 / (KP * ppdV): GOSUB Cursor
IF B$ = "P" THEN CPY = CPY - 4 / (KP * ppdV): GOSUB Cursor
REM Here are the special MapFIx routines
REM IF B$ = "=" THEN
REM x%(Z) = DX + (CUX - 320) / KP
REM y%(Z) = DY + (CUY - Ycen) / KP
REM GOSUB DrawMap
REM END IF
REM IF B$ = ">" THEN GOSUB SaveMap
IF a$ = "6" THEN CPX = CPX - 20 / (KP * ppdV): GOSUB Cursor'SHIFT Cursor by 4
IF a$ = "4" THEN CPX = CPX + 20 / (KP * ppdV): GOSUB Cursor
IF a$ = "8" THEN CPY = CPY + 20 / (KP * ppdV): GOSUB Cursor
IF a$ = "2" THEN CPY = CPY - 20 / (KP * ppdV): GOSUB Cursor
END IF
REM LOCATE 25, 3: PRINT "F3 to save new Map Point. F4 to save New Map to file named NEWMAP";
LOOP
SYSTEM 'you should never get here
ErrorTrap: fault = ERR: 'Error handling routine
IF ERR = 57 THEN PRINT " I/O-error-User-logoff"; : RESUME
IF ERR = 69 THEN PRINT " Comm-buffer-overflow"; : RESUME
IF ERR = 53 THEN PRINT " file-"; File$; "-not-found": CLOSE : RESUME NEXT
IF ERR = 62 THEN RESUME NEXT
IF ERR = 2 THEN PRINT "SYNTAX-error"
RESET
PRINT : PRINT "Error beyond repair. Number = "; ERR;
INPUT "Hit RETURN to return to DOS"; a$
SYSTEM
MapList: CLS : PRINT "MAP FILES LIST": PRINT
PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
PRINT "For example, the default '\APRS\*.MAP' will show all maps in the APRS"
PRINT "directory. Similarly '*.map' will search your present QB directory."
PRINT "For any other path, enter the full file specification.": PRINT
F$ = "\aprs\*.map"
PRINT "Enter Filespec ("; F$; ")";
INPUT a$: IF a$ <> "" THEN F$ = a$
PRINT : PRINT : FILES F$
RETURN
LoadMap: 'Ecoast map X/640=16 deg and Y/200=10 deg. for 40 & 20 Pix-per-deg
'Now modified so that original map data is 640/375...
'Raw map = 256 mile scale so RngScale = 256 for ppdV=20
'Modified so that now vertical scale is 400 vice 200 or 375
Again: LOCATE 23, 1: INPUT "Which mapfile to look at (or CR for list)"; a$
IF a$ = "" THEN GOSUB MapList: GOTO Again
a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".map"
LET File$ = a$: OPEN File$ FOR INPUT AS #3
IF fault = 53 THEN fault = 0: RETURN
INPUT #3, LATo: LINE INPUT #3, LatText$
INPUT #3, LONo: LINE INPUT #3, LonText$
INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
INPUT #3, LatCen: LINE INPUT #3, LatCen$
INPUT #3, LonCen: LINE INPUT #3, LonCen$
INPUT #3, MapRng: LINE INPUT #3, MapRng$
INPUT #3, MinRng: LINE INPUT #3, Mr$
RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
REM KP = 256 / RS
i = 0: LNi = 0: LINE INPUT #3, a$' Ignore line of instrutcitons
DO WHILE NOT EOF(3)
i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
END IF
LOOP: nmp = i
LET CDY = LatCen: CDX = LonCen'Center display on ORIGIN
LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
LET Z = 2: LNptr = 1: REM start at first point and first line segment
CLOSE #3: RETURN: REM first X% value is map color. 2nd val is 1st pt
NextLine: i = Z
DO UNTIL i = UBOUND(x%)
i = i + 1: IF x%(i) = 0 THEN Z = i + 1: LNptr = LNptr + 1: EXIT DO
LOOP: GOTO ShowLine
Previous: i = Z
DO UNTIL i = LBOUND(x%)
i = i - 1: IF x%(i) = 0 THEN Z = i - 1: LNptr = LNptr - 1: EXIT DO
LOOP
ShowLine: CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
IF LEFT$(LN$(LNptr), 6) = "Labels" THEN Z = 2: LNptr = 1
IF Z < 2 THEN Z = 2: LNptr = 1
LOCATE 23, 40
PRINT "LineName: "; LEFT$(LN$(LNptr) + " ", 20);
RETURN
LoadLabels: k = 0
DO WHILE NOT EOF(3)
k = k + 1: INPUT #3, ML$(k), Mla(k), MLo(k), MLr(k)
LOOP: NML = k: RETURN
SaveMap: OPEN "newmap" FOR OUTPUT AS #4
PRINT #4, LAT; LatText$
PRINT #4, LON; LonText$
PRINT #4, ppdV; VS$
PRINT #4, LatCen; LatCen$
PRINT #4, LonCen; LonCen$
PRINT #4, MapRng; MapRng$
PRINT #4, MinRng; MS$
PRINT #4, "Format line for comments. ETC"
FOR i = 1 TO nmp
PRINT #4, x%(i); INT((y%(i) / Yfactr) + .5)
NEXT i: CLOSE #4: RETURN
CurDrwMap: CDX = CPX: CDY = CPY
DrawMap: 'Draw to range scale RS and center display CDX and CDY
'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
'Now ppdH and ppdV are variables. The scaling factor KP is 1 for
'the original map scale.
IF RS < MinRng THEN LET RS = MinRng
KP = 100 * 120 / (RS * ppdV)'This is to scale it down from the 120 maps
Lfac = COS(CDY / 57.296)
DX = ppdV * (LONo - CDX)
DY = (LATo - CDY) * ppdV * Yfactr
CLS : LOCATE 1, 2: PRINT "Redrawing Map"
REM first put ORIGIN and map CENTER on the map
LINE (320 - KP * DX, Ycen - KP * DY)-(960 - KP * DX, Ycen - KP * DY), 14
LINE (320 - KP * DX, Ycen - KP * DY)-(320 - KP * DX, 3 * Ycen - KP * DY), 14
CMX = 320 + KP * (CDX - LonCen) * ppdV
CMY = Ycen + KP * (CDY - LatCen) * ppdV * Yfactr
LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
CIRCLE (CMX, CMY), 10, 14
CIRCLE (320 - KP * DX, Ycen - KP * DY), 12, 14
FOR i = 0 TO nmp - 1
x = 320 + KP * (x%(i) - DX): y = Ycen + KP * (y%(i) - DY)
X1 = 320 + KP * (x%(i + 1) - DX): Y1 = Ycen + KP * (y%(i + 1) - DY)
IF x%(i + 1) <> 0 THEN
IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
ELSE LineColor = y%(i + 1): i = i + 1
END IF
NEXT i
CPX = CDX: CPY = CDY: GOSUB Cursor' Cursor Posn to center
LOCATE 25, 1: PRINT "Use + and - to move MAPpoint. N for next line segment. P for previous.";
LOCATE 1, 60: PRINT "TOTAL PTS:"; nmp; "="; INT(nmp / 10); "%";
Labels: IF Labls THEN
FOR i = 1 TO NML ' Now plot labels on map
IF RS <= MLr(i) OR Key$ = "S" THEN
LET x = 320 + KP * (CDX - MLo(i)) * ppdV
LET y = Ycen + KP * (CDY - Mla(i)) * ppdV * Yfactr
IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
END IF
END IF
NEXT i
END IF: RETURN
Grid: 'draw lat/long degree lines THIS HAS NOT BEEN FIXED FOR DIFF MAPS
FOR i = 0 TO 16: LINE (i * 40, 0)-(i * 40, 400 * Yfactr), 1: NEXT i
FOR i = 0 TO 10: LINE (0, i * 400 * Yfactr / 10)-(640, i * 400 * Yfactr / 10), 1: NEXT i
LOCATE 23, 1: a = INT(.5 + (RS * 60 / 256))
IF RS = 256 THEN PRINT "Grid in degrees"
IF RS < 256 THEN PRINT "Grid every"; a; "minutes"
RETURN
Cursor: CIRCLE (CUX, CUY), 4, 0
LET CUX = 320 + KP * (CDX - CPX) * ppdV
LET CUY = Ycen + KP * (CDY - CPY) * ppdV * Yfactr
CIRCLE (CUX, CUY), 4, 12
x = INT(CPX): y = INT(CPY): xm = (CPX - x) * 60: ym = (CPY - y) * 60
x$ = RIGHT$(STR$(x), 3) + " "
LOCATE 1, 2: PRINT "RNG"; RIGHT$(" " + STR$(RS), 4) + " "
LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(ym) + " ", 2, 5)
LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(xm) + " ", 2, 5)
LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
REM MAP DEBUG
IF Z < 1 THEN Z = 1 ELSE IF Z >= nmp - 1 THEN Z = nmp - 1
IF x%(Z) = 0 AND a$ = "+" THEN LNptr = LNptr + 1: Z = Z + 1
IF x%(Z) = 0 AND a$ = "-" THEN LNptr = LNptr - 1: Z = Z - 1
IF LNptr < 0 THEN LNptr = 0
GOSUB ShowLine ' and erase old mappoint pointer
Xtest = KP * (x%(Z) - DX) + 320: Ytest = KP * (y%(Z) - DY) + Ycen
CIRCLE (Xtest, Ytest), 10, 11
LOCATE 23, 1: PRINT "MapPt #"; Z; "X/Y vals:";
PRINT TAB(23); x%(Z); TAB(29); y%(Z)
PRINT "Cursor coordinates:"; TAB(23);
PRINT INT(.5 + DX + (CUX - 320) / KP); TAB(29); INT(.5 + DY + (CUY - Ycen) / KP);
LOCATE 24, 40: PRINT "Degrees: ";
PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + " ", 7);
LET a$ = "": LET B$ = "": RETURN
Help: CLS : LINE (0, 0)-(639, 18 * Yfactr), 14, BF: LOCATE 1, 34: PRINT " HELP SCREEN "
LOCATE 3, 1
PRINT " This program finds map points for fixing lines or adding labels. The cursor"
PRINT " is shown in both LAT/LONG, map coordiniates and in decimal degrees. The map"
PRINT " ORIGIN is shown by two yellow lines and a circle. Labels are right justified"
PRINT " about where a period(.) should be. Stations & objects will be left justified."
PRINT ""
PRINT " G - Grid overlay S - Show all Labels"
PRINT " N - Next line segment M - Map files list"
PRINT " P - Previous line segment L - Labels on/off"
PRINT " Q - QUIT & return to QB + - Move to next map point"
PRINT " H - HELP screen - - Move to previous map point"
PRINT
PRINT " On the MAP screen, use the white arrow keys with NumLock off for best movement"
PRINT " Space bar - Draw map"
PRINT " Arrow Keys - Move cursor. (use Shift to move faster)"
PRINT " Home - Home the map to the cursor coordinates"
PRINT " PgUp, PgDn - Change map scale up/dn by 2 (use CTRL for factor of 8)"
PRINT " End - Redraw map centered on ORIGIN"
PRINT
PRINT " Observe your map, make notes, Quit. Then Load ur map as a DOCUMENT and edit!"
PRINT
LOCATE 25, 1: PRINT "Use + and - to move MAPpoint. N for next line segment. P for previous.";
LINE (0, 0)-(634, 348 * Yfactr), 15, B
RETURN
END