Заливка экрана - QBasic

DECLARE SUB Blit ()
DECLARE SUB BrozLN (x1%, y1%, x2%, y2%, cv%)
DECLARE SUB NullPg ()
DECLARE SUB Blit ()
DECLARE SUB PaintXY (x%, y%, c%)
DECLARE SUB Obrazec ()
 
CONST MaxIndx = 1000
CONST Debug = 0   ' 1 - Режим демонстрации работы алгоритма
DIM SHARED Scr(79, 99) AS INTEGER
DIM SHARED Prov%(MaxIndx, 1), TekTk%, TekDob%, TekCv%
 
SCREEN 0
WIDTH 80, 50
CLS 2
 
  Obrazec
  Blit
  PRINT "Unpainted... Press any key...";
  WHILE INKEY$ = "": WEND
  PaintXY 5, 8, 1
  Blit
  LOCATE , 1: PRINT "Painted..."
 
SUB Blit
DIM cv(1, 1) AS INTEGER
cv(0, 0) = 0
cv(1, 0) = 223
cv(0, 1) = 220
cv(1, 1) = 219
 DEF SEG = &HB800
  FOR y = 0 TO 49
     FOR x = 0 TO 79
       POKE y * 160 + x + x, cv(Scr(x, y + y), Scr(x, y + y + 1))
     NEXT
  NEXT
 DEF SEG
END SUB
 
SUB BrozLN (x1%, y1%, x2%, y2%, cv%)
   StpX% = x2% - x1%
   StpY% = y2% - y1%
   DlX% = ABS(StpX% + 1)
   DlY% = ABS(StpY% + 1)
 
   StpX% = SGN(StpX%)
   StpY% = SGN(StpY%)
   Scr(x1%, y1%) = cv%
 
   IF DlX% >= DlY% THEN   ' Передвигаемся по X
     Px% = x1%: Py% = y1%: Nabor% = 0: Plus% = DlY%
     DO
       Nabor% = Nabor% + Plus%
       Px% = Px% + StpX%
       IF Nabor% >= DlX% THEN
         Py% = Py% + StpY%
         Nabor% = Nabor% - DlX%
       END IF
       Scr(Px%, Py%) = cv%
     LOOP UNTIL Px% = x2%
   ELSE
     Px% = x1%: Py% = y1%: Nabor% = 0: Plus% = DlX%
     DO
       Nabor% = Nabor% + Plus%
       Py% = Py% + StpY%
       IF Nabor% >= DlY% THEN
         Px% = Px% + StpX%
         Nabor% = Nabor% - DlY%
       END IF
       Scr(Px%, Py%) = cv%
     LOOP UNTIL Py% = y2%
   END IF
END SUB
 
SUB NullPg
  ERASE Scr
 
END SUB
 
SUB Obrazec
    BrozLN 4, 6, 4, 11, 1
    BrozLN 4, 11, 32, 11, 1
    BrozLN 4, 6, 44, 6, 1
    BrozLN 44, 6, 56, 12, 1
    BrozLN 56, 12, 63, 3, 1
    BrozLN 63, 5, 77, 5, 1
    BrozLN 77, 5, 77, 35, 1
    BrozLN 33, 11, 44, 11, 1
    BrozLN 44, 11, 56, 17, 1
    BrozLN 56, 17, 63, 8, 1
    BrozLN 63, 10, 73, 10, 1
    BrozLN 73, 10, 73, 30, 1
    BrozLN 77, 35, 69, 35, 1
    BrozLN 69, 35, 69, 14, 1
    BrozLN 65, 10, 65, 41, 1
    BrozLN 65, 41, 72, 82, 1
    BrozLN 69, 35, 77, 85, 1
    BrozLN 77, 85, 77, 90, 1
    BrozLN 77, 90, 68, 90, 1
    BrozLN 67, 90, 52, 75, 1
    BrozLN 52, 75, 48, 70, 1
    BrozLN 48, 70, 45, 64, 1
    BrozLN 45, 64, 43, 55, 1
    BrozLN 43, 55, 43, 41, 1
    BrozLN 72, 82, 68, 82, 1
    BrozLN 68, 82, 54, 68, 1
    BrozLN 54, 68, 51, 63, 1
    BrozLN 51, 63, 49, 57, 1
    BrozLN 49, 57, 49, 41, 1
    BrozLN 49, 41, 53, 41, 1
    BrozLN 53, 41, 63, 73, 1
    BrozLN 63, 73, 66, 73, 1
    BrozLN 66, 73, 58, 25, 1
    BrozLN 58, 25, 25, 25, 1
    BrozLN 25, 25, 25, 35, 1
    BrozLN 25, 35, 7, 35, 1
    BrozLN 7, 35, 7, 30, 1
    BrozLN 7, 30, 20, 30, 1
    BrozLN 20, 30, 20, 23, 1
    BrozLN 20, 23, 61, 23, 1
    BrozLN 61, 23, 61, 20, 1
    BrozLN 61, 20, 52, 20, 1
    BrozLN 52, 20, 43, 15, 1
    BrozLN 43, 15, 18, 15, 1
    BrozLN 18, 15, 3, 24, 1
    BrozLN 3, 24, 3, 40, 1
    BrozLN 3, 40, 25, 40, 1
    BrozLN 25, 40, 25, 44, 1
    BrozLN 25, 44, 3, 44, 1
    BrozLN 3, 44, 3, 49, 1
    BrozLN 3, 49, 25, 49, 1
    BrozLN 25, 49, 25, 53, 1
    BrozLN 25, 53, 3, 53, 1
    BrozLN 3, 53, 3, 58, 1
    BrozLN 3, 58, 25, 58, 1
    BrozLN 25, 58, 25, 62, 1
    BrozLN 25, 62, 3, 62, 1
    BrozLN 3, 62, 3, 67, 1
    BrozLN 3, 67, 25, 67, 1
    BrozLN 25, 67, 2, 89, 1
    BrozLN 4, 89, 9, 95, 1
    BrozLN 9, 95, 65, 95, 1
    BrozLN 65, 95, 39, 69, 1
    BrozLN 39, 69, 39, 41, 1
    BrozLN 39, 41, 43, 41, 1
END SUB
 
SUB PaintXY (x%, y%, c%)
 
 TekCv% = Scr(x%, y%)   ' Возьмем цвет под точкой закраса
 TekDob% = 1            ' Позицию точки в очередь
 Prov%(TekDob%, 0) = x%
 Prov%(TekDob%, 1) = y%
 DO
   TekTk% = TekTk% + 1
   IF TekTk% > MaxIndx THEN TekTk% = 0
   Xtt% = Prov%(TekTk%, 0)
   Ytt% = Prov%(TekTk%, 1)
   CvP% = Scr(Xtt%, Ytt%)   ' Цвет под точкой
   IF CvP% = TekCv% THEN
     Scr(Xtt%, Ytt%) = c%
       IF Xtt% > 0 THEN
         TekDob% = TekDob% + 1
         IF TekDob% > MaxIndx THEN TekDob% = 0
         Prov%(TekDob%, 0) = Xtt% - 1
         Prov%(TekDob%, 1) = Ytt%
       END IF
       IF Xtt% < 79 THEN
         TekDob% = TekDob% + 1
         IF TekDob% > MaxIndx THEN TekDob% = 0
         Prov%(TekDob%, 0) = Xtt% + 1
         Prov%(TekDob%, 1) = Ytt%
       END IF
       IF Ytt% > 0 THEN
         TekDob% = TekDob% + 1
         IF TekDob% > MaxIndx THEN TekDob% = 0
         Prov%(TekDob%, 0) = Xtt%
         Prov%(TekDob%, 1) = Ytt% - 1
       END IF
       IF Ytt% < 99 THEN
         TekDob% = TekDob% + 1
         IF TekDob% > MaxIndx THEN TekDob% = 0
         Prov%(TekDob%, 0) = Xtt%
         Prov%(TekDob%, 1) = Ytt% + 1
       END IF
   END IF
   IF Debug = 1 THEN
     k% = k% + 1
     IF k% > 50 THEN
       k% = 0
       T = TIMER
       Blit
       WHILE T = TIMER: WEND
     END IF
   END IF
 LOOP UNTIL TekTk% = TekDob%
 
END SUB