REM gd1bbc.bas - jackord@kw.igs.net - revised 27 Feb 08 - BBC BASIC (RTR)
      REM solution of Laplace's equation:
      REM   128 iterations at 4 pixel steps
      REM    16 iterations at 2 pixel steps
      REM     6 iterations at 1 pixel steps
      
      *FLOAT 64
      INSTALL @lib$+"WINLIB5"
      
      button% = FN_button("Plot", 30, 1, 65, 20, FN_setproc(PROCplot), 0)
      REM  textbox#1.tx, 110, 170, 65, 20
      WindowWidth=204     : REM pixel scale 0-204
      WindowHeight=190    : REM pixel scale 0-190
      VDU 23,22,WindowWidth;WindowHeight;8,15,16,128
      SYS "SetWindowText", @hwnd%, "Laplace's Equation"
      
      ON CLOSE PROCundim(v()) : QUIT
      DIM p(4): DIM q(4): DIM c%(6): PROCdim2d(v(), 8, 205, 169)
      p(1)=60: q(1)=60: p(2)=102: q(2)=132: p(3)=144: q(3)=60
      c%(0)=12: c%(1)=14: c%(2)=9
      c%(3)=11: c%(4)=5: c%(5)=10
      PROCpin
      
      REPEAT
        WAIT 1
      UNTIL FALSE
      
      DEF PROCpin
      CLS
      GCOL 0
      VDU 5 : MOVE 210,374 : PRINT "Pass/150";
      GCOL 12 : RECTANGLE 0, 0, 406, 334
      GCOL 9
      FOR i=1 TO 3
        CIRCLE FILL p(i)*2, q(i)*2, 12
      NEXT i
      ENDPROC
      
      DEF PROCplot
      d=4: nplt=8
      FOR k=d TO 168-d
        FOR j=d TO 204-d
          v(j, k)=50
        NEXT j
      NEXT k
      FOR i=1 TO 3
        FOR k=q(i)-6 TO q(i)+6
          FOR j=p(i)-6 TO p(i)+6
            r2=(p(i)-j)*(p(i)-j)+(q(i)-k)*(q(i)-k)
            IF r2<=36 THEN v(j, k)=100
          NEXT j
        NEXT k
      NEXT i
      FOR i=1 TO 150
        GCOL 15
        RECTANGLE FILL 210,336,190,42
        GCOL 0
        MOVE 210,374 : PRINT "Pass "; STR$(i) "/150";
        FOR k=d TO 168-d STEP d
          FOR j=d TO 204-d STEP d
            IF v(j, k)<100 THEN
              v(j, k)=(v(j, k-d)+v(j, k+d)+v(j+d, k)+v(j-d, k))/4
            ENDIF
            IF i=1 OR i=nplt THEN
              plt=INT(v(j, k)/7): plt=plt-6*INT(plt/6)
              GCOL c%(plt)
              IF d<2 THEN
                LINE (j-1)*2, k*2, j*2, k*2
              ELSE
                RECTANGLE FILL j*2-d, k*2-d, d*2, d*2
              ENDIF
            ENDIF
          NEXT j
        NEXT k
        IF i=128 OR i=144 THEN
          d=d/2
          FOR k=d TO 168-d STEP 2*d
            FOR j=2*d TO 204-2*d STEP 2*d
              IF v(j, k)<100 THEN v(j, k)=(v(j, k-d)+v(j, k+d))/2
            NEXT j
          NEXT k
          FOR k=d TO 168-d STEP d
            FOR j=d TO 204-d STEP 2*d
              IF v(j, k)<100 THEN v(j, k)=(v(j-d, k)+v(j+d, k))/2
            NEXT j
          NEXT k
        ENDIF
        IF i=nplt THEN nplt=nplt+2*d
      NEXT i
      GCOL 15
      RECTANGLE FILL 210,336,190,42
      GCOL 0
      MOVE 210,374 : PRINT "Finished!";
      ENDPROC
      
      DEF PROCdim2d(RETURN A(),S%,D1%,D2%)
      LOCAL A%
      SYS "GlobalAlloc", 64, 9+S%*(D1%+1)*(D2%+1) TO A%
      ?A%=2 : A%!1=D1%+1 : A%!5=D2%+1
      !^A() = A%
      ENDPROC
      
      DEF PROCundim(RETURN A())
      SYS "GlobalFree", !^A()
      !^A() = 0
      ENDPROC