REM Bigmap v1.0 REM Freeware 1997 Jim Vassilakos REM San Bernardino, California REM jimv@empirenet.com REM Written in Microsoft QuickBasic version 4.5 REM Includes SAVESCR v0.6 by Aaron Zabudsky REM REM Sample Usage = bigmap 1 sample\map\n000e000.map DECLARE SUB savescr (filename$, sx!, sy!, ex!, ey!, nbits!, imgnum!) DEF FNx (f1$) f1 = VAL(MID$(f1$, 6, 3)) IF UCASE$(MID$(f1$, 5, 1)) = "W" THEN f1 = -f1 FNx = f1 END DEF DEF FNy (f1$) f1 = VAL(MID$(f1$, 2, 3)) IF UCASE$(MID$(f1$, 1, 1)) = "S" THEN f1 = -f1 FNy = f1 END DEF DEF FNsx (f1$) f1 = VAL(f1$) f2 = INT((f1 - 1) / 40) f3 = f1 - (f2 * 40) FNsx = f3 END DEF DEF FNsy (f1$) f1 = VAL(f1$) f2 = INT((f1 - 1) / 40) + 1 FNsy = f2 END DEF SCREEN 12: CLS REM c$ = "1 sample\map\n000e000.map" C$ = COMMAND$ IF C$ = "" GOTO 9000 c1 = VAL(LEFT$(C$, 1)) c2$ = MID$(C$, 3, LEN(C$) - 14) c3$ = RIGHT$(C$, 12) cx = FNx(c3$) cy = FNy(c3$) depth = c1 * 4 IF c1 = 1 THEN size = 80 IF c1 = 2 THEN size = 40 startx = (640 / 2) - (size / 2) starty = (480 / 2) - (size / 2) tog1 = 1: tog2 = 1 OPEN "r", 1, "tmp.tmp" CLOSE 1 SHELL "erase tmp.tmp" REM create mapfile list sh$ = "for %f in (" + c2$ + "*.map) do echo %f >> tmp.tmp" SHELL sh$ 100 REM CLS OPEN "i", 1, "tmp.tmp" DO UNTIL EOF(1) LINE INPUT #1, t$ dx = FNx(RIGHT$(t$, 12)) dy = FNy(RIGHT$(t$, 12)) da = dx - cx db = cy - dy IF ABS(da) <= depth AND ABS(db) <= depth THEN dc = da * size + startx dd = db * size + starty OPEN "i", 2, t$ LINE INPUT #2, t$ FOR a = 1 TO 40 LINE INPUT #2, t$ FOR b = 1 TO 40 e = ASC(MID$(t$, b, 1)) - 65 IF c1 = 1 THEN ex = dc + (b * 2) IF a / 2 = INT(a / 2) THEN ex = ex + 1 ey = dd + (a * 2) IF ex > 0 AND ex < 639 AND ey > 1 AND ey < 479 THEN LINE (ex, ey)-(ex + 1, ey + 1), e, BF END IF END IF IF c1 = 2 THEN ex = dc + b ey = dd + a IF ex > 0 AND ex < 640 AND ey > 1 AND ey < 480 THEN PSET (ex, ey), e END IF END IF NEXT b NEXT a IF c1 = 1 AND (tog1 = 1 OR tog2 = 1) THEN DO UNTIL EOF(2) LINE INPUT #2, t$ IF t$ <> "" THEN IF LEFT$(t$, 1) = "@" AND tog1 = 1 THEN IF MID$(t$, 7, 1) = "1" THEN ec = FNsx(MID$(t$, 2, 4)) ed = FNsy(MID$(t$, 2, 4)) ex = dc + (ec * 2) ey = dd + (ed * 2) IF ed / 2 = INT(ed / 2) THEN ex = ex + 1 IF ex > 0 AND ex < 640 AND ey > 1 AND ey < 480 THEN IF POINT(ex, ey) = 15 THEN CIRCLE (ex, ey), 1, 0 PSET (ex, ey), 1 ELSE CIRCLE (ex, ey), 1, 15 PSET (ex, ey), 0 END IF END IF END IF END IF IF LEFT$(t$, 1) = "$" AND tog2 = 1 THEN ec = FNsx(MID$(t$, 2, 4)) ed = FNsy(MID$(t$, 2, 4)) ex = dc + (ec * 2) ey = dd + (ed * 2) IF ed / 2 = INT(ed / 2) THEN ex = ex + 1 ee = FNsx(MID$(t$, 7, 4)) ef = FNsy(MID$(t$, 7, 4)) ex2 = dc + (ee * 2) ey2 = dd + (ef * 2) IF ef / 2 = INT(ef / 2) THEN ex2 = ex2 + 1 eg = VAL(MID$(t$, 12, 1)) eh = VAL(MID$(t$, 13, 1)) ex2 = ex2 + ((eg - 2) * 80) ey2 = ey2 + ((eh - 2) * 80) el = ASC(RIGHT$(t$, 1)) - 65 LINE (ex, ey)-(ex2, ey2), el END IF END IF LOOP END IF CLOSE 2 END IF LOOP CLOSE 1 200 GOSUB 900 IF k2 = 0 AND (k1 >= 97 AND k1 <= 122) THEN k1 = k1 - 32 IF k2 = 1 AND k1 = 72 GOTO 210: REM up IF k2 = 1 AND k1 = 80 GOTO 220: REM down IF k2 = 1 AND k1 = 75 GOTO 230: REM left IF k2 = 1 AND k1 = 77 GOTO 240: REM right IF k2 = 0 AND (k1 = 63 OR k1 = 82) GOTO 250: REM ?/R IF k2 = 0 AND k1 = 27 GOTO 10000: REM esc IF k2 = 0 AND k1 = 81 GOTO 10000: REM Q IF k2 = 1 AND k1 = 59 GOTO 290: REM F1 IF k2 = 1 AND k1 = 60 GOTO 295: REM F2 IF k2 = 1 AND k1 = 68 GOTO 280: REM F10 GOTO 200 210 REM up cy = cy + depth GOTO 100 220 REM down cy = cy - depth GOTO 100 230 REM left cx = cx - depth GOTO 100 240 REM right cx = cx + depth GOTO 100 250 REM help CLS : COLOR 11: LOCATE 5 PRINT "You can use the arrow keys to move around. The " PRINT "key will exit. Lines and small-font locations are" PRINT "shown on the 'big map', but not the 'really big map'," PRINT "and they may be toggled via F1 and F2. F10 will do a" PRINT "screen-dump to bigmap.bmp." PRINT : PRINT "Hit any key to return to the map..." GOSUB 900 GOTO 100 280 REM save screen bmpfile$ = "bigmap.bmp" bmp = 1: REM goto 100 285 bmp = 0 savescr bmpfile$, 0, 0, 639, 479, 4, 0 SCREEN 0: CLS : LOCATE 5: COLOR 11 PRINT PRINT "World map saved to "; bmpfile$ PRINT PRINT "Hit any key to return to the map" PRINT GOSUB 900 GOTO 100 290 REM toggle place markers tmp = tog1 IF tmp = 1 THEN tog1 = 0 IF tmp = 0 THEN tog1 = 1 GOTO 100 295 REM toggle lines tmp = tog2 IF tmp = 1 THEN tog2 = 0 IF tmp = 0 THEN tog2 = 1 GOTO 100 900 REM get character from keyboard k1 = 0: k2 = 0 910 k$ = INKEY$ IF k$ = "" THEN GOTO 910 k1 = ASC(k$) IF k1 <> 0 THEN RETURN k1 = ASC(RIGHT$(k$, 1)) k2 = 1 RETURN 9000 CLS : COLOR 12: LOCATE 5 PRINT "Bigmap is a sub-program of Mapper and is not designed" PRINT "to be run as a stand-alone. Use F6 or F7 from Mapper" PRINT "to properly enter Bigmap." PRINT PRINT "Hit any key..." GOSUB 900 GOTO 10005 10000 REM end SHELL "erase tmp.tmp" 10005 SCREEN 0: COLOR 7: CLS PRINT PRINT "For Assistance and/or Snide Remarks:" PRINT PRINT " Email: jimv@empirenet.com" PRINT " JimVassila@aol.com" PRINT " jimv@cs.ucr.edu" PRINT " jimv@silver.lcs.mit.edu" PRINT PRINT " Homepage: http://www.cs.ucr.edu/~jimv" PRINT END SUB savescr (filename$, sx, sy, ex, ey, nbits, imgnum) 'SAVESCR V0.6 - Screen Capture Function for Qbasic. 'By: Aaron Zabudsky 'Date: July 17, 1997 'Free - Comments welcome. ' 'Usage: filename$ - Name of the file you want to capture to. Overwrites any ' old image that may be under that name. ' sx - Starting X coordinate ' sy - Starting Y coordinate ' ex - Ending X coordinate ' ey - Ending Y coordinate ' nbits - Number of bits you want in your bitmap. Use 1, 4 or 8. ' Use nbits=1 for SCREEN 11 ' Use nbits=4 for SCREEN 12 ' Use nbits=8 for SCREEN 13 ' imgnum - The current number of the image you are saving to. ' This can be anything if you have specified a filename ' If you have specified a blank filename (""), Autonumbering ' is enabled and if you specify a number here, it will save ' the image as CAP0.BMP, CAP1.BMP,...,CAP1000.BMP,etc. ' If you leave a variable in this spot when you call the ' capture function, the function will automatically increment ' the variable, so you can "auto-capture" a series of ' pictures without worrying about numbers. ' ' e.g. savescr "test.bmp",0,0,639,479,4,0 ' will capture the entire SCREEN 12 screen with 16 colours and save it ' to test.bmp. ' savescr "",0,0,319,199,8,t ' will capture the entire SCREEN 13 screen with 256 colours and save it ' as CAP#.BMP, where # is the current value of t, it will then increment ' t. ' savescr "",0,0,639,479,1,(t) ' will capture the entire SCREEN 11 screen with 2 colours and save it ' as CAP#.BMP as in the previous example, but this time t will not be ' incremented. IF filename$ = "" THEN filename$ = "CAP" + LTRIM$(RTRIM$(STR$(imgnum))) + ".BMP" imgnum = imgnum + 1 END IF OPEN filename$ FOR BINARY AS #1 IF LOF(1) <> 0 THEN 'Alter this code here if you don't want it to overwrite existing files. CLOSE 1 KILL filename$ OPEN filename$ FOR BINARY AS #1 END IF va = &H3C7 'VGA Palette Read Address Register vd = &H3C9 'VGA Palette Data Register zero$ = CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) 'Check extents to order points. IF sx > ex THEN SWAP sx, ex IF sy > ey THEN SWAP sy, ey 'Use Windows BMP Header. Size=40 headersize = 40 'Calculate Picture width,height picwidth = ex - sx + 1 picheight = ey - sy + 1 'Set Colour Information 'Planes [W] - Must be 1 nplanes = 1 'Calculate offset [LW] to start of data IF nbits = 1 OR nbits = 4 OR nbits = 8 THEN offset = 14 + headersize + 4 * (2 ^ nbits) ELSE offset = 14 + headersize END IF 'Type of file [W] (Should be BM) ft$ = "BM" 'File Size [LW] (excluding header) IF nbits = 1 THEN IF (picwidth MOD 32) <> 0 THEN filesize = 4 * (INT(picwidth / 32) + 1) * picheight ELSE filesize = (picwidth / 8) * picheight END IF ELSEIF nbits = 4 THEN IF (picwidth MOD 8) <> 0 THEN filesize = 4 * (INT(picwidth / 8) + 1) * picheight ELSE filesize = (picwidth / 2) * picheight END IF ELSEIF nbits = 8 THEN IF (picwidth MOD 4) <> 0 THEN filesize = 4 * (INT(picwidth / 4) + 1) * picheight ELSE filesize = picwidth * picheight END IF ELSEIF nbits = 24 THEN IF (3 * picwidth MOD 4) <> 0 THEN filesize = 4 * (INT(3 * picwidth / 4) + 1) * picheight ELSE filesize = 3 * picwidth * picheight END IF END IF 'Set reserved values [W] (both must be zero) r1 = 0 r2 = 0 'Compression type [LW] - None comptype = 0 'Image Size [LW]; Scaling Factors xsize, ysize unused. imagesize = offset + filesize xsize = 0 ysize = 0 'Assume all colours used [LW] - 0 means all colours. coloursused = 0 neededcolours = 0 header$ = ft$ + MKL$(filesize) + MKI$(r1) + MKI$(r2) + MKL$(offset) infoheader$ = MKL$(headersize) + MKL$(picwidth) infoheader$ = infoheader$ + MKL$(picheight) + MKI$(nplanes) infoheader$ = infoheader$ + MKI$(nbits) + MKL$(comptype) + MKL$(imagesize) infoheader$ = infoheader$ + MKL$(xsize) + MKL$(ysize) + MKL$(coloursused) infoheader$ = infoheader$ + MKL$(neededcolours) 'Write headers to BMP File. PUT #1, 1, header$ PUT #1, , infoheader$ 'Add palette - Get colours (Write as B0G0R0(0),B1G1R1(0),...) IF nbits = 1 OR nbits = 4 OR nbits = 8 THEN palet$ = "" OUT va, 0 FOR count = 1 TO 2 ^ nbits zr = INP(vd) * 4 zg = INP(vd) * 4 zb = INP(vd) * 4 palet$ = palet$ + CHR$(zb) + CHR$(zg) + CHR$(zr) + CHR$(0) NEXT count PUT #1, , palet$ palet$ = "" 'Save some memory END IF stpoint = POINT(sx, ey + 1) 'BMPs are arranged with the top of the image at the bottom of the file. 'Get points off the screen and pack into bytes depending on the number of 'bits used. Deal with unused bits at the end of the line. 'Check for invalid range. FOR count2 = ey TO sy STEP -1 lin$ = "" IF nbits = 1 THEN count1 = sx WHILE count1 <= ex IF count1 + 7 > ex THEN t = 0 FOR count0 = 0 TO 7 p = POINT(count1 + count0, count2) IF p < 0 THEN p = 0 t = t + (2 ^ (7 - count0)) * (p MOD 2) NEXT count0 t2 = ex - count1 + 1 t = t AND ((2 ^ t2) - 1) * (2 ^ (8 - t2)) lin$ = lin$ + CHR$(t) ELSE t = 0 FOR count0 = 0 TO 7 p = POINT(count1 + count0, count2) IF p < 0 THEN p = 0 t = t + (2 ^ (7 - count0)) * (p MOD 2) NEXT count0 lin$ = lin$ + CHR$(t) END IF count1 = count1 + 8 WEND ELSEIF nbits = 4 THEN count1 = sx WHILE count1 <= ex IF count1 = ex THEN p = POINT(count1, count2) IF p < 0 THEN p = 0 lin$ = lin$ + CHR$((p MOD 16) * 16) ELSE p = POINT(count1, count2) p2 = POINT(count1 + 1, count2) IF p < 0 THEN p = 0 IF p2 < 0 THEN p2 = 0 lin$ = lin$ + CHR$((p MOD 16) * 16 + p2) END IF count1 = count1 + 2 WEND ELSEIF nbits = 8 THEN FOR count1 = sx TO ex p = POINT(count1, count2) IF p < 0 THEN p = 0 lin$ = lin$ + CHR$(p) NEXT count1 ELSEIF nbits = 24 THEN 'I'm not sure what to put here. QBasic doesn't support truecolour 'Unused for now. END IF 'Pad line to LongWord boundary IF (LEN(lin$) MOD 4) <> 0 THEN lin$ = lin$ + MID$(zero$, 1, 4 - (LEN(lin$) MOD 4)) END IF 'Indicate our status PSET (sx, count2 + 1), stpoint stpoint = POINT(sx, count2) IF nbits = 8 THEN PSET (sx, count2), 255 - stpoint ELSEIF nbits = 4 THEN PSET (sx, count2), 15 - stpoint ELSEIF nbits = 1 THEN PSET (sx, count2), 1 - stpoint END IF 'Write the current line to the BMP file PUT #1, , lin$ NEXT count2 'Save some memory lin$ = "" PSET (sx, count2 + 1), stpoint 'Close the file CLOSE END SUB