DECLARE SUB makemaze (map%(), maxi%, maxj%) DECLARE SUB thickline (cx%(), cy%(), x%, y%, ex%, ey%, count%) DECLARE FUNCTION chk% (x%, y%, ex%, ey%, map%()) DECLARE SUB drawline (cx%(), cy%(), x%, y%, ex%, ey%, count%) DECLARE SUB delpath (cx%(), cy%(), start%, finish%, count%) DECLARE SUB addpath (cx%(), cy%(), count%, tx%(), ty%(), ln%, start%) DECLARE SUB rotate (dx%, dy%) DECLARE SUB rotatec (dx%, dy%) SCREEN 12 'define the scale and sizes sc% = 5 maxi% = 120 maxj% = 80 RANDOMIZE TIMER DIM map%(120, 80) DIM cx%(10000) DIM cy%(10000) DIM tx%(10000) DIM ty%(10000) DIM SHARED tempx%(8000) DIM SHARED tempy%(8000) CALL makemaze(map%(), maxi%, maxj%) DO i% = INT(RND * (maxi% - 1)) + 1 j% = INT(RND * (maxj% - 1)) + 1 LOOP UNTIL map%(i%, j%) = 0 'set start location x% = i% y% = j% FOR i% = x% - 1 TO x% + 1 FOR j% = y% - 1 TO y% + 1 map%(i%, j%) = 0 NEXT NEXT map%(x%, y%) = 12 DO i% = INT(RND * (maxi% - 1)) + 1 j% = INT(RND * (maxj% - 1)) + 1 LOOP UNTIL map%(i%, j%) = 0 'set goal location ex% = i% ey% = j% FOR i% = ex% - 1 TO ex% + 1 FOR j% = ey% - 1 TO ey% + 1 map%(i%, j%) = 0 NEXT NEXT map%(ex%, ey%) = 13 'draw the map FOR i% = 0 TO imax% FOR j% = 0 TO jmax% LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B NEXT j% NEXT i% 'line 'walk around objects 'remove excess travel 'trivial case-end is same as start count% = 0 'location in cx%...point alont the path CALL thickline(cx%(), cy%(), x%, y%, ex%, ey%, count%) count% = count% + 1 FOR i% = 0 TO count% - 1 IF map%(cx%(i%), cy%(i%)) = 0 THEN map%(cx%(i%), cy%(i%)) = 1 NEXT i% FOR i% = 0 TO maxi% FOR j% = 0 TO maxj% LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B NEXT j% NEXT i% 'find path around objects '*********************************** tc% = 0 dtx% = 0 dty% = 0 half% = 0 block% = 0 i% = 0 DO i% = i% + 1 IF map%(cx%(i%), cy%(i%)) > 2 THEN block% = 1 xs% = cx%(i% - 1) ys% = cy%(i% - 1) x% = xs% y% = ys% dx% = cx%(i%) - cx%(i% - 1) dy% = cy%(i%) - cy%(i% - 1) dxflag% = 0 WHILE map%(x% + dx%, y% + dy%) > 2 CALL rotate(dx%, dy%) WEND dxs% = dx% dys% = dy% DO tx%(tc%) = x% + dx% ty%(tc%) = y% + dy% tc% = tc% + 1 LOCATE 20, 1 x% = x% + dx% y% = y% + dy% IF map%(x%, y%) = 1 OR map%(x%, y%) = 2 THEN IF (dtx% * dtx% + dty% * dty%) <= (x% - xs%) * (x% - xs%) + (y% - ys%) * (y% - ys%) THEN half% = tc% - 1 dtx% = ABS(x% - xs%) dty% = ABS(y% - ys%) IF map%(x%, y%) = 2 THEN map%(x%, y%) = 1 END IF END IF CALL rotatec(dx%, dy%) CALL rotatec(dx%, dy%) WHILE map%(x% + dx%, y% + dy%) > 2 CALL rotate(dx%, dy%) WEND LOOP UNTIL x% = xs% AND y% = ys% AND dxs% = dx% AND dys% = dy% last% = 1 ELSE IF map%(cx%(i%), cy%(i%)) <= 2 THEN last% = 0 'set last marker to available END IF IF half% >= tc% - 1 AND block% = 1 THEN count% = i% ELSEIF (tc% - 1) / 2 >= half% AND block% = 1 THEN j% = i% erx% = ABS(tx%(half%) - cx%(j%)) ery% = ABS(ty%(half%) - cy%(j%)) WHILE erx% >= ABS(tx%(half%) - cx%(j%)) AND ery% >= ABS(ty%(half%) - cy%(j%)) erx% = ABS(tx%(half%) - cx%(j%)) ery% = ABS(ty%(half%) - cy%(j%)) j% = j% + 1 WEND FOR p% = j% TO count% - 1 tempx%(p%) = cx%(p%) tempy%(p%) = cy%(p%) NEXT p% FOR p% = 0 TO half% cx%(p% + i%) = tx%(p%) cy%(p% + i%) = ty%(p%) NEXT p% PRINT j%, i% FOR p% = j% TO count% - 1 cx%(p% + half% - (j% - i%) + 1) = tempx%(p%) cy%(p% + half% - (j% - i%) + 1) = tempy%(p%) NEXT p% count% = count% + half% - (j% - i%) + 1 block% = 0 i% = i% + half% - (j% - i%) + 1 tc% = 0 dtx% = 0 dty% = 0 half% = 0 ELSEIF (tc% - 1) / 2 < half% AND block% = 1 THEN FOR k% = 0 TO tc% - 2 tempx%(k%) = tx%(tc% - k% - 2) tempy%(k%) = ty%(tc% - k% - 2) NEXT k% FOR k% = 0 TO tc% - 2 tx%(k%) = tempx%(k%) ty%(k%) = tempy%(k%) NEXT k% half% = tc% - half% - 2 j% = i% erx% = ABS(tx%(half%) - cx%(j%)) ery% = ABS(ty%(half%) - cy%(j%)) WHILE erx% >= ABS(tx%(half%) - cx%(j%)) AND ery% >= ABS(ty%(half%) - cy%(j%)) erx% = ABS(tx%(half%) - cx%(j%)) ery% = ABS(ty%(half%) - cy%(j%)) j% = j% + 1 WEND FOR p% = j% TO count% - 1 tempx%(p%) = cx%(p%) tempy%(p%) = cy%(p%) NEXT p% FOR p% = 0 TO half% cx%(p% + i%) = tx%(p%) cy%(p% + i%) = ty%(p%) NEXT p% PRINT j%, i% FOR p% = j% TO count% - 1 cx%(p% + half% - (j% - i%) + 1) = tempx%(p%) cy%(p% + half% - (j% - i%) + 1) = tempy%(p%) NEXT p% count% = count% + half% - (j% - i%) + 1 block% = 0 i% = i% + half% - (j% - i%) + 1 tc% = 0 dtx% = 0 dty% = 0 half% = 0 END IF LOOP UNTIL i% >= count% - 2 FOR i% = 0 TO maxi% FOR j% = 0 TO maxj% LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B NEXT j% NEXT i% count% = count% - 1 'remove duplicated paths j% = 0 DO FOR i% = j% + 1 TO count% IF cx%(i%) = cx%(j%) AND cy%(i%) = cy%(j%) THEN CALL delpath(cx%(), cy%(), j% + 1, i%, count%): GOTO 20 NEXT i% 20 : j% = j% + 1 LOOP UNTIL j% >= count% 'erase any dark blue marks FOR i% = 0 TO maxi% FOR j% = 0 TO maxj% IF map%(i%, j%) = 1 THEN map%(i%, j%) = 0 LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B NEXT j% NEXT i% 'walk along path FOR i% = 0 TO count% LINE (cx%(i%) * sc%, cy%(i%) * sc%)-(cx%(i%) * sc% + sc%, cy%(i%) * sc% + sc%), 4, BF now = TIMER DO LOOP UNTIL TIMER > now + .1 LINE (cx%(i%) * sc%, cy%(i%) * sc%)-(cx%(i%) * sc% + sc%, cy%(i%) * sc% + sc%), map%(cx%(i%), cy%(i%)), BF LINE (cx%(i%) * sc%, cy%(i%) * sc%)-(cx%(i%) * sc% + sc%, cy%(i%) * sc% + sc%), 7, B NEXT i% i% = count% LINE (cx%(i%) * sc%, cy%(i%) * sc%)-(cx%(i%) * sc% + sc%, cy%(i%) * sc% + sc%), 4, BF SUB addpath (cx%(), cy%(), count%, tx%(), ty%(), ln%, start%) FOR i% = 0 TO ln% + count% IF i% < start% THEN tempx%(i%) = cx%(i%) tempy%(i%) = cy%(i%) END IF IF i% >= start% AND i% <= start% + ln% THEN tempx%(i%) = tx%(i% - start%) tempy%(i%) = ty%(i% - start%) END IF IF i% > start% + ln% THEN tempx%(i%) = cx%(i% - ln% - 1) tempy%(i%) = cy%(i% - ln% - 1) END IF NEXT i% FOR i% = 0 TO ln% + count% cx%(i%) = tempx%(i%) cy%(i%) = tempy%(i%) NEXT i% count% = count% + ln% END SUB FUNCTION chk% (x%, y%, ex%, ey%, map%()) chk% = 0 'line drawing algorithm dx% = ex% - x% dy% = ey% - y% xdir% = SGN(dx%) ydir% = SGN(dy%) IF ABS(dx%) >= ABS(dy%) THEN 'quadrant 0 or 3 dx% = ABS(dx%) dy% = ABS(dy%) dyx2% = dy% * 2 dyx2mdx2% = dyx2% - dx% * 2 er% = dyx2% - dx% x0% = x% y0% = y% FOR i% = dx% - 1 TO 0 STEP -1 IF er% >= 0 THEN y0% = y0% + ydir% er% = er% + dyx2mdx2% 'IF map%(x0%, y0%) = 0 THEN map%(x0%, y0%) = 2 ELSE er% = er% + dyx2% END IF x0% = x0% + xdir% IF map%(x0%, y0%) > 2 THEN chk% = 1 NEXT i% ELSE dx% = ABS(dx%) dy% = ABS(dy%) dxx2% = dx% * 2 dxx2mdy2% = dxx2% - dy% * 2 er% = dxx2% - dy% x0% = x% y0% = y% FOR i% = dy% - 1 TO 0 STEP -1 IF er% >= 0 THEN x0% = x0% + xdir% er% = er% + dxx2mdy2% ELSE er% = er% + dxx2% END IF y0% = y0% + ydir% IF map%(x0%, y0%) > 2 THEN chk% = 1 NEXT i% END IF END FUNCTION SUB delpath (cx%(), cy%(), start%, finish%, count%) new% = 0 FOR j% = 0 TO count% + 1 IF j% < start% OR j% > finish% THEN cx%(new%) = cx%(j%) cy%(new%) = cy%(j%) new% = new% + 1 END IF NEXT j% count% = count% - (finish% - start%) - 1 END SUB SUB drawline (cx%(), cy%(), x%, y%, ex%, ey%, count%) 'line drawing algorithm count% = 0 dx% = ex% - x% dy% = ey% - y% xdir% = SGN(dx%) ydir% = SGN(dy%) IF ABS(dx%) >= ABS(dy%) THEN 'quadrant 0 or 3 dx% = ABS(dx%) dy% = ABS(dy%) dyx2% = dy% * 2 dyx2mdx2% = dyx2% - dx% * 2 er% = dyx2% - dx% x0% = x% y0% = y% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 FOR i% = dx% - 1 TO 0 STEP -1 IF er% >= 0 THEN y0% = y0% + ydir% er% = er% + dyx2mdx2% ELSE er% = er% + dyx2% END IF x0% = x0% + xdir% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 NEXT i% ELSE dx% = ABS(dx%) dy% = ABS(dy%) dxx2% = dx% * 2 dxx2mdy2% = dxx2% - dy% * 2 er% = dxx2% - dy% x0% = x% y0% = y% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 FOR i% = dy% - 1 TO 0 STEP -1 IF er% >= 0 THEN x0% = x0% + xdir% er% = er% + dxx2mdy2% ELSE er% = er% + dxx2% END IF y0% = y0% + ydir% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 NEXT i% END IF count% = count% - 1 END SUB SUB makemaze (map%(), maxi%, maxj%) 'fill with blockers FOR i% = 0 TO maxi% FOR j% = 0 TO maxj% map%(i%, j%) = 3 LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B NEXT j% NEXT i% i% = INT(RND * (maxi% / 2 - 1)) * 2 + 1 j% = INT(RND * (maxj% / 2 - 1)) * 2 + 1 nump% = 0 DO check2% = 0 count% = 0 DO count% = count% + 1 choose% = INT(RND * 4) IF choose% = 0 THEN oi% = i% + 2: oj% = j% IF choose% = 1 THEN oi% = i% - 2: oj% = j% IF choose% = 2 THEN oi% = i%: oj% = j% + 2 IF choose% = 3 THEN oi% = i%: oj% = j% - 2 IF oi% >= 1 AND oj% >= 1 AND oi% <= maxi% AND oj% <= maxj% THEN IF map%(oi%, oj%) = 3 THEN check2% = 1 END IF LOOP UNTIL check2% = 1 OR count% > 7 IF check2% = 1 THEN i% = oi% j% = oj% map%(i%, j%) = 0 IF choose% = 0 THEN map%(i% - 1, j%) = 0 IF choose% = 1 THEN map%(i% + 1, j%) = 0 IF choose% = 2 THEN map%(i%, j% - 1) = 0 IF choose% = 3 THEN map%(i%, j% + 1) = 0 'LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), map%(i%, j%), BF 'LINE (i% * sc%, j% * sc%)-(i% * sc% + sc%, j% * sc% + sc%), 7, B ELSE nump% = nump% + 1 DO i% = INT(RND * (maxi% / 2 - 1)) * 2 + 1 j% = INT(RND * (maxj% / 2 - 1)) * 2 + 1 LOOP UNTIL map%(i%, j%) = 0 END IF LOOP UNTIL nump% > 1000 END SUB SUB rotate (dx%, dy%) dxo% = dx% dx% = (.7 * dx% + .7 * dy%) dy% = (-.7 * dxo% + .7 * dy%) END SUB SUB rotatec (dx%, dy%) dxo% = dx% dx% = (.7 * dx% + -.7 * dy%) dy% = (.7 * dxo% + .7 * dy%) END SUB SUB thickline (cx%(), cy%(), x%, y%, ex%, ey%, count%) 'line drawing algorithm count% = 0 dx% = ex% - x% dy% = ey% - y% xdir% = SGN(dx%) ydir% = SGN(dy%) IF ABS(dx%) >= ABS(dy%) THEN 'quadrant 0 or 3 dx% = ABS(dx%) dy% = ABS(dy%) dyx2% = dy% * 2 dyx2mdx2% = dyx2% - dx% * 2 er% = dyx2% - dx% x0% = x% y0% = y% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 FOR i% = dx% - 1 TO 0 STEP -1 IF er% >= 0 THEN y0% = y0% + ydir% er% = er% + dyx2mdx2% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 ELSE er% = er% + dyx2% END IF x0% = x0% + xdir% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 NEXT i% ELSE dx% = ABS(dx%) dy% = ABS(dy%) dxx2% = dx% * 2 dxx2mdy2% = dxx2% - dy% * 2 er% = dxx2% - dy% x0% = x% y0% = y% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 FOR i% = dy% - 1 TO 0 STEP -1 IF er% >= 0 THEN x0% = x0% + xdir% er% = er% + dxx2mdy2% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 ELSE er% = er% + dxx2% END IF y0% = y0% + ydir% cx%(count%) = x0% cy%(count%) = y0% count% = count% + 1 NEXT i% END IF count% = count% - 1 END SUB