'===========================================================================
' Subject: ANOTHER PAINT REPLACEMENT          Date: 03-09-96 (09:28)       
'  Author: Rich Gordley                       Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: EGAVGA.ABC
'===========================================================================
'This was harder than I anticipated, but I was surprised at how fast it is.
'Could be made faster if the POINT functions were replaced by PEEKs but I
'didn't want to spend the time researching SCREEN 9 to implement them

DEFINT A-Z

SCREEN 9

'several shapes to show universal applicability

'LINE (100, 100)-(300, 150), 4, B
'RECTANGLE
'CIRCLE (112, 105), 30, 4
'CIRCLE
' an hourglass like figure
LINE (200, 100)-(100, 50), 4
LINE (100, 50)-(300, 50), 4
LINE (300, 50)-(250, 100), 4
LINE (250, 100)-(300, 150), 4
LINE (300, 150)-(100, 150), 4
LINE (100, 150)-(200, 100), 4

'initv = 105   'FOR CIRCLE OR FOR RECTANGLE
'inith = 112
'v = 105
'h = 112
inith = 225   'for the irregular polygon
initv = 95
h = 225
v = 95
stuck = 0
found = 0
     GOSUB makeline
        DO
        IF found = 1 THEN
        GOSUB reloc
        GOSUB makeline
        END IF
        LOOP UNTIL found <> 1

'relocate to initial coordinates
     v = initv: h = inith
     GOSUB makeline2
     DO
     IF found = 1 THEN
     GOSUB reloc
     GOSUB makeline2
     END IF
     LOOP UNTIL found <> 1

DO
A$ = INKEY$
LOOP UNTIL A$ <> ""
END

setpoint:
      PSET (h, v), 3
RETURN

makeline:
'draws a line from initial position all the way to the left and
'all the way to the right, looking for the first hole in the
'ceiling it can find.

'move left
found = 0
holev = 0
holeh = 0
'look up before moving to see if there is a hole
DO
IF found = 0 THEN
'if no hole yet found then check for one
IF POINT(h, v - 1) <> 4 THEN
          holev = v - 1: holeh = h
          found = 1
     END IF
END IF
h = h - 1

IF POINT(h, v) <> 4 THEN   'can we move left?
  GOSUB setpoint    'mark and move
ELSE
  h = h + 1
  stuck = 1
END IF
LOOP UNTIL stuck = 1

'move right
'reset flag
stuck = 0
DO
IF found = 0 THEN 'if no hole yet found then check for one
     IF POINT(h, v - 1) <> 4 THEN
          holev = v - 1: holeh = h
          found = 1
     END IF
END IF
h = h + 1

IF POINT(h, v) <> 4 THEN   'can we move right?
  GOSUB setpoint    'mark and move
ELSE
  h = h - 1
  stuck = 1
END IF
LOOP UNTIL stuck = 1

stuck = 0
RETURN


reloc:
h = holeh
v = holev
RETURN

makeline2:
'draws a line from initial position all the way to the left and
'all the way to the right, looking for the first hole in the
'floor it can find.

'move left
found = 0
holev = 0
holeh = 0
'look up before moving to see if there is a hole
DO
IF found = 0 THEN 'if no hole yet found then check for one
     IF POINT(h, v + 1) <> 4 THEN
          holev = v + 1: holeh = h
          found = 1
     END IF
END IF
h = h - 1

IF POINT(h, v) <> 4 THEN   'can we move left?
  GOSUB setpoint    'mark and move
ELSE
  h = h + 1
  stuck = 1
END IF
LOOP UNTIL stuck = 1

'move right
'reset flag
stuck = 0
DO
IF found = 0 THEN 'if no hole yet found then check for one
     IF POINT(h, v + 1) <> 4 THEN
          holev = v + 1: holeh = h
          found = 1
     END IF
END IF
h = h + 1

IF POINT(h, v) <> 4 THEN   'can we move right?
   GOSUB setpoint          'mark and move
ELSE
  h = h - 1
  stuck = 1
END IF

LOOP UNTIL stuck = 1

stuck = 0

RETURN