Teletext paint program

bbc micro/electron/atom/risc os coding queries and routines
Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Fri Jul 31, 2020 8:49 pm

pixelblip wrote:
Fri Jul 31, 2020 7:50 pm
I copied your brilliant flood fill code in Richard but it's crashing so need to work that out.....it must be something simple as it runs on it's own.
Here is a port of it to "my" pixel-twiddling interface... (Lines below 490 are a copy of the library)

Code: Select all

   10MODE 7
   20
   70REPEAT
   80CLS: FOR Y% = 0 TO 24: PRINT TAB(0,Y%) CHR$&97;: NEXT
   90IF POS REM n.b. SDL thread sync
  100PROCbresenham(10,22,60,15)
  110PROCbresenham(60,15,72,60)
  120PROCbresenham(72,60,10,22)
  140WAIT 100
  150
  160PROCflood(40,24)
  170WAIT 100
  180UNTIL FALSE
  190END
  200
  210DEF PROCflood(X%, Y%)
  220LOCAL L%, R%
  230IF FNpoint(X%,Y%) ENDPROC
  240L% = X%
  250R% = X%
  260WHILE FNpoint(L%-1,Y%) = 0 : L% -= 1 : ENDWHILE
  270WHILE FNpoint(R%+1,Y%) = 0 : R% += 1 : ENDWHILE
  280PROCbresenham(L%,Y%,R%,Y%)
  290FOR X% = L% TO R% STEP 2
  300PROCflood(X%, Y%+1)
  310PROCflood(X%, Y%-1)
  320NEXT
  330ENDPROC
  340
  350DEF PROCbresenham(x1%,y1%,x2%,y2%)
  360LOCAL dx%, dy%, sx%, sy%, e
  370dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
  380dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
  390IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
  400REPEAT
  410PROCpoint(1,x1%,y1%)
  420IF x1% = x2% IF y1% = y2% GOTO 485
  430IF dx% > dy% THEN
  440x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
  450ELSE
  460y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
  470ENDIF
  480UNTIL FALSE
  485UNTIL TRUE
  490ENDPROC
  500
  510
  520
  530REM Library for pixel plotting in MODE 7
  540
  550REM Using a virtual coordinate system that has 0,0 at the bottom left.
  560REM 0,0 corresponds to the bottom line, second character cell
  570REM (as it's impossible to put graphics in the left-most cell)
  580REM X range is 0 to 77. Y range is 0 to 74 (3 vertical per sixel)
  590
  600DEFFNsxbit(sx%, sy%)
  610IF sx% = 0 AND sy% = 0 THEN =16
  620IF sx% = 0 AND sy% = 1 THEN =4
  630IF sx% = 0 AND sy% = 2 THEN =1
  640IF sx% = 1 AND sy% = 0 THEN =64
  650IF sx% = 1 AND sy% = 1 THEN =8
  660IF sx% = 1 AND sy% = 2 THEN =2
  670=0
  680
  690REM Read the point at the specified coordinates (1=set, 0=cleared)
  700REM This can be optimised to one line, but it's left expanded
  710REM for clarity to show how it works.
  720
  730DEFFNpoint(x%,y%)
  740LOCAL cx%,cy%,chr%,sx%,sy%
  750REM Get character cell
  760cx% = 1+(x% DIV 2)
  770cy% = 24-(y% DIV 3)
  780chr%=GET(cx%,cy%) AND &5F
  790sx% = x% MOD 2
  800sy% = y% MOD 3
  810=SGN(chr% AND FNsxbit(sx%,sy%))
  820
  830REM Plot a Teletext sixel point. The first parameter means:
  840REM 0: Clear the point
  850REM 1: Set the point
  860REM 2: Toggle the point
  870DEFPROCpoint(cmd%, x%, y%)
  880LOCAL cx%,cy%,chr%,sx%,sy%,tx%,ty%
  890REM Get character cell
  900cx% = 1+(x% DIV 2)
  910cy% = 24-(y% DIV 3)
  920chr%=GET(cx%,cy%) AND &5F
  930sx% = x% MOD 2
  940sy% = y% MOD 3
  950CASE cmd% OF
  960WHEN 0:chr% AND=(&5F - FNsxbit(sx%,sy%))
  970WHEN 1:chr% OR=FNsxbit(sx%,sy%)
  980WHEN 2:chr% EOR=FNsxbit(sx%,sy%)
  990ENDCASE
 1000tx%=POS: ty%=VPOS
 1010PRINT TAB(cx%,cy%)CHR$(chr%+160);TAB(tx%,ty%);
 1020ENDPROC
Matrix Brandy BASIC VI (work in progress)

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Fri Jul 31, 2020 8:51 pm

pixelblip wrote:
Fri Jul 31, 2020 8:37 pm
Then I will start to refine it.......i.e start thinking about arrays and how to do that.
But will you? I know only too well that once it's working, even if a bit rough, there's not much incentive for tidying up!

I still think the best solution is to implement both the plotting/drawing and the flood-fill in terms of a PROC for setting a pixel (sixel) and an FN for reading a pixel. That way you can at any stage switch between the PROC/FN being implemented by means of GET/VDU (e.g. using Michael's code) or by accessing the system character map (e.g. using my code). You can see which works better/faster without - in principle anyway - risking anything breaking.

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Fri Jul 31, 2020 10:00 pm

Good point Richard. Once I have it working will I delve down further........the stuff talked about like arrays and storing screens is a lot to get my head around for a newbie but it has sparked something inside.....a natural curiosity. I will take in what you have said here.

Thanks Soruk that is very helpful you did that with the fill! I am very grateful to you all.

I find it very interesting all of this. It's exciting knowing that even in the early stages now I have something I can almost use - on an Ipad....the possibility of animation looms which is something I have dearly wanted in teletext.

User avatar
FourthStone
Posts: 949
Joined: Thu Nov 17, 2016 2:29 am
Location: Brisbane, Australia
Contact:

Re: Teletext paint program

Post by FourthStone » Fri Jul 31, 2020 10:09 pm

Here is the fill routine from ART adapted for teletext screen, it has bounds checking and can fill right to the edge of the 'graphics' window.

It can also fill complex shapes but does have a limited stack which could be expanded if you're running into fill issues, it will just stop filling if the quasi stack is full.

*EDIT* Updated with complex shape :D

Code: Select all

      MODE 7

      DIM fill{(100) x%,y%}

      FOR Y% = 0 TO 24
        PRINT TAB(0,Y%) CHR$&97;
      NEXT
      VDU 28,1,24,39,0

      REM drawing bounds
      xMin%=2
      xMax%=77
      yMin%=3
      yMax%=74

      REM fill bounds
      fxMin%=1
      fxMax%=78
      fyMin%=2
      fyMax%=75


      CLS
      IF POS REM n.b. SDL thread sync
      PROCbresenham(xMin%,yMin%,xMax%,yMin%)
      PROCbresenham(xMax%,yMin%,xMax%,yMax%)
      PROCbresenham(xMax%,yMax%,xMin%,yMin%)

      PROCbresenham(xMin%+10,yMin%+5,xMax%-5,yMin%+5)
      PROCbresenham(xMax%-5,yMin%+5,xMax%-5,yMax%-10)
      PROCbresenham(xMax%-5,yMax%-10,xMin%+10,yMin%+5)

      PROCbresenham(xMin%,yMin%+10,xMax%-10,yMax%)
      PROCbresenham(xMax%-10,yMax%,xMin%,yMax%)
      PROCbresenham(xMin%,yMax%,xMin%,yMax%-20)
      PROCbresenham(xMin%,yMax%-20,xMin%+15,yMax%-20)
      PROCbresenham(xMin%+15,yMax%-20,xMin%+15,yMax%-15)
      PROCbresenham(xMin%+15,yMax%-15,xMin%+20,yMax%-15)
      PROCbresenham(xMin%+20,yMax%-15,xMin%+20,yMax%-30)
      PROCbresenham(xMin%+20,yMax%-30,xMin%,yMax%-30)
      PROCbresenham(xMin%,yMax%-30,xMin%,yMin%+10)

      VDU 23,18,3|

      WAIT 100

      PROCfloodFill(40,24)
      PROCfloodFill(10,24)

      VDU 23,18,3|
      WAIT 100

      G=GET$
      END

      REM ### flood fill from ART4BBW
      DEF PROCfloodFill(sx%,sy%)

      IF sx%>fxMin% AND sx%<fxMax% AND sy%>fyMin% AND sy%<fyMax% THEN

        LOCAL uf,df,c%,x%,y%,mc%
        uf=0
        df=0

        REM fill with mask colour first
        bCnt%=0
        PROCaddFill(sx%,sy%)

        REPEAT
          REM get next fill point
          bCnt%-=1
          x%=fill{(bCnt%)}.x%
          y%=fill{(bCnt%)}.y%
          IF FNgetpixel(x%,y%) = 0 THEN

            uf=1 : df=1

            REM scan left
            WHILE x%>xMin% AND FNgetpixel(x%-1,y%) =0
              x%-=1
            ENDWHILE

            REM scan right
            WHILE x%<fxMax% AND FNgetpixel(x%,y%) = 0
              PROCsetpixel(x%,y%)

              REM detect colour changes above and add to list
              IF y%<fyMax% THEN
                c%=FNgetpixel(x%,y%+1)
                IF uf AND c%=0 THEN PROCaddFill(x%,y%+1) : uf=0
                IF c%=1 THEN uf=1
              ENDIF

              REM detect colour changes below and add to list
              IF y%>fyMin% THEN
                c%=FNgetpixel(x%,y%-1)
                IF df AND c%=0 THEN PROCaddFill(x%,y%-1) : df=0
                IF c%=1 THEN df=1
              ENDIF
              x%+=1
            ENDWHILE
          ENDIF

        UNTIL bCnt%=0
      ENDIF

      ENDPROC

      REM ### fill quasi stack
      DEF PROCaddFill(x%,y%)
      fill{(bCnt%)}.x%=x%
      fill{(bCnt%)}.y%=y%
      IF bCnt%<100 THEN bCnt%+=1
      ENDPROC


      DEF PROCbresenham(x1%,y1%,x2%,y2%)
      LOCAL dx%, dy%, sx%, sy%, e
      dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
      dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
      IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
      REPEAT
        PROCsetpixel(x1%,y1%)
        IF x1% = x2% IF y1% = y2% EXIT REPEAT
        IF dx% > dy% THEN
          x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
        ELSE
          y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
        ENDIF
      UNTIL FALSE
      ENDPROC

      DEF PROCsetpixel(X%,Y%)
      LOCAL p%%,M%
      p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
      M% = (X% AND 1) + (Y% MOD 3) * 2
      IF M% = 5 M% = &40 ELSE M% = 1 << M%
      ?p%% OR= M%
      ENDPROC

      DEF FNgetpixel(X%,Y%)
      LOCAL p%%,M%
      p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
      M% = (X% AND 1) + (Y% MOD 3) * 2
      IF M% = 5 M% = &40 ELSE M% = 1 << M%
      = ?p%% AND M%
Last edited by FourthStone on Sat Aug 01, 2020 5:11 am, edited 1 time in total.

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Fri Jul 31, 2020 10:10 pm

Gosh all of you have chipped in so much! Thanks again!

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Sun Aug 02, 2020 10:24 am

Arrrgh programmming! Part of me loves it and and the other part of me wants nothing more to do with it!!! ARRRGH. You will all have been here many times before. If I am struggling with this I keep thinking what's it like to write BBC Basic for Windows or Matrix Brandy ( or ART4Eva! ). It consumes vasts amount of little time doesn't it everyone!
That is why I have great respect for all of you who are good at this. Of course it is all just logic. It is still blimmin' hard!

I am just trying to work out why the co-ordinates are all reversing themselves when it comes to the fill routine and Setpixel function.

Basically when I went to fill it was all over the place and I though huh what on earth.

I cut n pasted the fill code (Fourthstone's version) into a blank program and discovered the setpixel routine in the fill routine works in reverse so if I move my mouse up the pixels plot down in reverse and if I move left the pixels plot to the right.

It's easy if you know how but my head is spinning.

Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Sun Aug 02, 2020 10:28 am

I notice you replaced your earlier post. However, these might help you to convert from screen pixel coordinates (as used by BBCSDL and Matrix Brandy and returned by MOUSE x,y,b) to Teletext pixels as used by my earlier code, and also to character cells.

Code: Select all

DEFFNscreen2m7(x%,y%)
x%=(x%/16)-2
y%=(y%/13.3333)
IF x%<0THENx%=0
=x%+(y%*256)

DEF FNscreen2chr(x%,y%)
x%=x%/32
y%=25-(y%/40)
=x%+(y%*256)
As I am trying to return two values in one, both return in the format:

Code: Select all

x = value MOD 256
y = value DIV 256
Matrix Brandy BASIC VI (work in progress)

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Sun Aug 02, 2020 10:34 am

Thanks Soruk you are a lifesaver.
Yes I deleted my earlier post as I thought I've asked enough questions and everyone is babyfeeding me and felt a bit bad.

The trouble is as you know you can get stuck on a little thing for ages that is quite basic. I will have a look now. Thanks very much.

PS I saw your Matrix brandy addons. Nice one! :)

Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Sun Aug 02, 2020 10:41 am

pixelblip wrote:
Sun Aug 02, 2020 10:34 am
Thanks Soruk you are a lifesaver.
Yes I deleted my earlier post as I thought I've asked enough questions and everyone is babyfeeding me and felt a bit bad.
I would not worry too much about that. Everybody has to start somewhere, and I dare say my graphic artistry would be something a nursery would be ashamed of!
Matrix Brandy BASIC VI (work in progress)

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Sun Aug 02, 2020 10:44 am

Oh bless you. Thanks!

The thing I knew already but now is coming to bite me on the bum is that if you are not organised and take time in your code to document it and use meaningful variables ( and don't bodge it ) then it is a lot easier as it grows. We learn the hard way!

I saved so many versions of it as I was going called 72.bbc 73.bbc that I couldn't remember what worked in which version. I am very disorganised! So I had to back track a bit and go back to a version where half of it worked.

That will teach me!

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Sun Aug 02, 2020 10:57 am

pixelblip wrote:
Sun Aug 02, 2020 10:24 am
if I move left the pixels plot to the right.
I find that very surprising because I thought that horizontal (X-coordinate) addressing always corresponded to increasing addresses moving to the right. Are you quite sure this is happening?

Vertical addressing (Y-coordinate) is another matter entirely because there are two standards. There are Cartesian coordinates (after René Descartes) in which the positive direction is upwards (as used for example in BBC BASIC, BMP files and generally in mathematics) and then there are systems based on physical memory addresses which usually - but not necessarily - have the positive direction being downwards.

So reversing the direction of vertical coordinates is common, but horizontal: never in my experience.

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Sun Aug 02, 2020 12:17 pm

Hi Richard.
Sorry for the blip....wi fi issues in windows oh joy

Well here is the basic code......to show you....it's got to be me but I just don't understand. I couldn't reproduce it but I can now. This code is copied from Fourthstone. It's got to be something silly I've done. When you paint up it paints down.
Thanks for your help.
Mike

Code: Select all

      
MODE 7

      DIM fill{(100) x%,y%}

      FOR Y% = 0 TO 24
        PRINT TAB(0,Y%) CHR$&97;
      NEXT
      VDU 28,1,24,39,0

      REM drawing bounds
      xMin%=2
      xMax%=77
      yMin%=3
      yMax%=74

      REM fill bounds
      fxMin%=1
      fxMax%=78
      fyMin%=2
      fyMax%=75



      REPEAT
        MOUSEX,Y,Z
        XC%=X/16
        YC%=Y/13


        VDU 23,18,3|
        PROCsetpixel(XC%,YC%)
        IF Z=1 PROCfloodFill(XC%,YC%)








      UNTIL FALSE

      REM ### flood fill from ART4BBW
      DEF PROCfloodFill(sx%,sy%)

      IF sx%>fxMin% AND sx%<fxMax% AND sy%>fyMin% AND sy%<fyMax% THEN

        LOCAL uf,df,c%,x%,y%,mc%
        uf=0
        df=0

        REM fill with mask colour first
        bCnt%=0
        PROCaddFill(sx%,sy%)

        REPEAT
          REM get next fill point
          bCnt%-=1
          x%=fill{(bCnt%)}.x%
          y%=fill{(bCnt%)}.y%
          IF FNgetpixel(x%,y%) = 0 THEN

            uf=1 : df=1

            REM scan left
            WHILE x%>xMin% AND FNgetpixel(x%-1,y%) =0
              x%-=1
            ENDWHILE

            REM scan right
            WHILE x%<fxMax% AND FNgetpixel(x%,y%) = 0
              PROCsetpixel(x%,y%)

              REM detect colour changes above and add to list
              IF y%<fyMax% THEN
                c%=FNgetpixel(x%,y%+1)
                IF uf AND c%=0 THEN PROCaddFill(x%,y%+1) : uf=0
                IF c%=1 THEN uf=1
              ENDIF

              REM detect colour changes below and add to list
              IF y%>fyMin% THEN
                c%=FNgetpixel(x%,y%-1)
                IF df AND c%=0 THEN PROCaddFill(x%,y%-1) : df=0
                IF c%=1 THEN df=1
              ENDIF
              x%+=1
            ENDWHILE
          ENDIF

        UNTIL bCnt%=0
      ENDIF

      ENDPROC

      REM ### fill quasi stack
      DEF PROCaddFill(x%,y%)
      fill{(bCnt%)}.x%=x%
      fill{(bCnt%)}.y%=y%
      IF bCnt%<100 THEN bCnt%+=1
      ENDPROC


      DEF PROCbresenham(x1%,y1%,x2%,y2%)
      LOCAL dx%, dy%, sx%, sy%, e
      dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
      dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
      IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
      REPEAT
        PROCsetpixel(x1%,y1%)
        IF x1% = x2% IF y1% = y2% EXIT REPEAT
        IF dx% > dy% THEN
          x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
        ELSE
          y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
        ENDIF
      UNTIL FALSE
      ENDPROC

      DEF PROCsetpixel(X%,Y%)
      LOCAL p%%,M%
      p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
      M% = (X% AND 1) + (Y% MOD 3) * 2
      IF M% = 5 M% = &40 ELSE M% = 1 << M%
      ?p%% OR= M%
      ENDPROC

      DEF FNgetpixel(X%,Y%)
      LOCAL p%%,M%
      p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
      M% = (X% AND 1) + (Y% MOD 3) * 2
      IF M% = 5 M% = &40 ELSE M% = 1 << M%
      = ?p%% AND M%


User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Sun Aug 02, 2020 12:25 pm

Soruk wrote:
Sun Aug 02, 2020 10:28 am

Code: Select all

x%=(x%/16)-2
y%=(y%/13.3333)
If I may be allowed some (hopefully constructive) criticism, converting from integer to float, performing a floating-point division, and converting back to an integer will not be conducive to performance. BBC BASIC has an integer division operator specifically for this purpose:

Code: Select all

x%=x%DIV16-2
The equivalent for y% is less clear cut, because you are not dividing by an integer in that case (the brackets do waste time though). One would have to experiment to discover whether this is faster:

Code: Select all

y%=y%*3 DIV 40

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Sun Aug 02, 2020 12:39 pm

pixelblip wrote:
Sun Aug 02, 2020 12:17 pm
When you paint up it paints down.
Re-read my reply. I said that reversing the vertical direction (Y coordinate) was common, so that's not a surprise. It was your claim that moving the mouse right caused it to paint left that I found surprising.

I am personally pleased that BBC BASIC (or to be precise the BBC Micro MOS) adopted Cartesian Coordinates, even if that is unusual. It makes it much easier to draw graphs and mathematical functions in general, which almost universally assume positive is upwards.

Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Sun Aug 02, 2020 12:46 pm

Richard Russell wrote:
Sun Aug 02, 2020 12:39 pm
I am personally pleased that BBC BASIC (or to be precise the BBC Micro MOS) adopted Cartesian Coordinates, even if that is unusual. It makes it much easier to draw graphs and mathematical functions in general, which almost universally assume positive is upwards.
The BBC, Spectrum and Amstrad CPC all had Cartesian coordinates in that graphics had Up as the positive Y direction, and also all had Down as the text positive Y direction.
Matrix Brandy BASIC VI (work in progress)

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Sun Aug 02, 2020 12:54 pm

Soruk wrote:
Sun Aug 02, 2020 12:46 pm
The BBC, Spectrum and Amstrad CPC all had Cartesian coordinates in that graphics had Up as the positive Y direction
Yes, but I think the Spectrum only adopted it (and probably the Amstrad too) because the BBC Micro led the way. It was then, and still is, unusual (e.g. default graphics addressing in Windows and SDL is positive downwards, although OpenGL is positive upwards I think).

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Thu Aug 06, 2020 10:59 pm

Hi Fourthstone ( or anyone ). The program is shaping up now.
I have been stuck for days trying to work out what is wrong with the fill. The fill code is complex.
Basically the fill code (PROCfloodFill) is filling in the wrong areas. So if you at the bottom of the screen it's filling the top. Same for left and right.
Everything needs to be reversed. How do you do that please? It's probably very simple buy my head has been in it for days now. I could sure do with a hand if someone has time. Thanks a lot

The line here invokes the fill: 1310 IF Z=4 AND Y%>2 AND CY%>1 AND tool$="fill" AND dontpaint%=0 AND CY%>2 VDU 23,18,3|:PROCfloodFill(X%,Y%)

Code: Select all

   
   10
   20
   30
   40
   50
   60 MODE 7
   70
   80 DIM S 7
   90
  100
  110 !S=&08040201
  120
  130 S!4=&4010
  140
  150 REM 70 Next a row of teletext control codes must be written down the left hand side of the screen to turn every line into a graphics display
  160 backcol%=0
  170 PROCGR
  180 PROCdrawmenu
  190
  200 VDU 23,1,23,39,1
  210
  220
  230 xMin%=2
  240 xMax%=77
  250 yMin%=3
  260 yMax%=74
  270
  280 REM fill bounds
  290 fxMin%=1
  300 fxMax%=78
  310 fyMin%=2
  320 fyMax%=75
  330
  340
  350
  360
  370 REM The main program follows
  380 X=10:Y=73
  390
  400 step%=2
  410 tool$="paint"
  420 MOUSE ON 0
  430 dontpaint%=0
  440 toolsel%=0
  450 circenx%=10
  460 circeny%=10
  470 offsetx%=-2
  480 offsety%=4
  490 col%=1
  500 animation%=0
  510 FOR frame%=1 TO 8
  520   PROCsavecurrentframe
  530 NEXT frame%
  540
  550 REPEAT
  560   REM  PRINTTAB(38,0) frame%;
  570   REM PRINTTAB(14,0) frame%;
  580
  590
  600   MOUSE X,Y,Z
  610   X%=(X/17.29)
  620
  630   Y%=Y/13.83
  640   CX%= X/32
  650   CY%= 24-Y/40.96
  660   IF CX%=1 AND CY%=0 AND Z=4 tool$="colred":col%=1:dontpaint%=1:toolsel%=1 : backcol%=1
  670   IF CX%=3 AND CY%=0  AND Z=4 tool$="colgreen":col%=2:dontpaint%=1 :toolsel%=1:    backcol%=2
  680   IF CX%=5 AND CY%=0  AND Z=4 tool$="colyel":col%=3:dontpaint%=1:toolsel%=1  :    backcol%=3
  690   IF CX%=7 AND CY%=0  AND Z=4 tool$="colblue":col%=4:dontpaint%=1  :toolsel%=1 :    backcol%=4
  700   IF CX%=9 AND CY%=0  AND Z=4 tool$="colmag":col%=5:dontpaint%=1  :toolsel%=1 :     backcol%=5
  710   IF CX%=11 AND CY%=0  AND Z=4 tool$="colcya":col%=6:dontpaint%=1 :toolsel%=1  :       backcol%=6
  720   IF CX%=13 AND CY%=0  AND Z=4 tool$="colwhite":col%=7:dontpaint%=1  :toolsel%=1 :        backcol%=7
  730
  740   IF CX%=15 AND CY%=0 AND Z=4 tool$="paint":dontpaint%=0
  750   IF CX%=16 AND CY%=0 AND Z=4 tool$="ditherpaint":dontpaint%=0
  760   IF CX%=17 AND CY%=0 AND Z=4 tool$="ditherpaintx2":dontpaint%=0
  770
  780   IF CX%=19 AND CY%=0 AND Z=4 tool$="clearscreen":dontpaint%=0:backcol%=0:PROCGR: PROCdrawmenu: backcol%=0: tool$="paint":dontpaint%=0
  790   IF CX%=20 AND CY%=0 AND Z=4 tool$="clearpapercol":dontpaint%=0:PROCGR:PROCdrawmenu: WAIT 50: backcol%=0: tool$="paint":dontpaint%=0
  800   IF CX%=21 AND CY%=0 AND Z=4 tool$="papercol":dontpaint%=0:
  810   IF CX%=23 AND CY%=0 AND Z=4 tool$="circle":dontpaint%=0:oswitch%=1
  820
  830   IF CX%=24 AND CY%=0 AND Z=4 tool$="rectangle":dontpaint%=0:
  840   IF CX%=25 AND CY%=0 AND Z=4 tool$="line":dontpaint%=0:
  850   IF CX%=26 AND CY%=0 AND Z=4 tool$="fill":dontpaint%=0: tool$="fill":dontpaint%=0
  860   IF CX%=27 AND CY%=0 AND Z=4 tool$="eraser":dontpaint%=0:
  870   IF CX%=28 AND CY%=0 AND Z=4 tool$="eraser":dontpaint%=2:
  880
  890   REM IF CX%=33 AND CY%=0 AND Z=4 temptool$=tool$: tool$="undo":PROCload7:tool$=temptool$
  900   IF CX%=35 AND CY%=0 AND Z=4 animation%=1
  910   IF CX%=36 AND CY%=0 AND Z=4 frame%=frame%-1: PROCloadnextframe
  920   IF CX%=37 AND CY%=0 AND Z=4 frame%=frame%+1: PROCloadnextframe
  930   IF CX%=38 AND CY%=0 AND Z=4 PROCplay
  940   IF CX%=31 AND CY%=0 AND Z=4 tool$="save":dontpaint%=2: PROCsavepic
  950   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="eraser" AND dontpaint%=2 AND CY%>2 PROCpoint(0,X%,Y%)
  960
  970
  980
  990   PRINTTAB(38,0)  CHR$(144+col%);CHR$(255);
 1000
 1010
 1020
 1030
 1040
 1050
 1060
 1070
 1080
 1090
 1100
 1110
 1120
 1130
 1140   REM PROCdrawcursor
 1150
 1160   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="paint" PROCbrushstroke
 1170
 1180   IF Z=4 AND Y%>2 AND CY%>1 AND dontpaint%=1 PROCbrushstroke
 1190   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="eraser" AND dontpaint%=0 AND CY%>2 PROCsave7: PRINTTAB(X/32,24-(Y/40.96)) " ";  :WAIT 20
 1200   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="ditherpaint" AND X% MOD 2=0 AND Y% MOD 2=0   PROCditherpaint1
 1210   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="ditherpaint2" AND X% MOD 2=0 AND Y% MOD 2=0   PROCditherpaint2
 1220   IF Z=4 AND CY%>0 AND tool$="circle" AND dontpaint%=0 PROCdrawcircleroutine
 1230   IF Z=4 AND CY%>0 AND tool$="papercol" AND dontpaint%=0 PROCnewpaperbackground
 1240   IF Z=4 AND dontpaint%=1  AND tool$="col" PROCdrawcol(X%,Y%)
 1250
 1260
 1270
 1280   IF Z=4 AND  CY%>0 AND tool$="rectangle" AND dontpaint%=0 PROCdrawrectangleroutine
 1290
 1300   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="line" AND dontpaint%=0 AND CY%>2 PROCsave7:PROCdrawlineroutine

 1310   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="fill" AND dontpaint%=0 AND CY%>2 VDU 23,18,3|:PROCfloodFill(X%,Y%)
 1320
 1330
 1340
 1350
 1360
 1370
 1380 UNTIL FALSE
 1390
 1400 END
 1410
 1420 REM and lastly here is the procedure to plot the point
 1430
 1440 DEF PROCPLOT(X%,Y%)
 1450
 1460 LOCAL C%,A%
 1470
 1480 VDU 31,X% DIV2+1, 24-Y% DIV3
 1490
 1500 C%=S?((X% AND 1)+(2-Y%MOD3) *2)
 1510
 1520 A%=135
 1530
 1540 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 1550
 1560
 1570 ENDPROC
 1580
 1590 DEF PROCERASE(X%,Y%)
 1600
 1610 LOCAL C%,A%
 1620
 1630 VDU 31,X% DIV2+1, 24-Y% DIV3
 1640
 1650 C%=S%?((X% AND 1)+(2-Y%MOD3) *2)
 1660
 1670 A%=133
 1680
 1690 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 1700
 1710 ENDPROC
 1720
 1730
 1740 DEF PROCGR
 1750
 1760
 1770
 1780 VDU 12
 1790
 1800 FOR counter%=1 TO 23
 1810   IF backcol%>0 PRINTTAB(0,counter%) CHR$(128+backcol%);CHR$(157);CHR$(151)
 1820   IF backcol%=0 VDU 10,13,&97
 1830
 1840 NEXT counter%
 1850 REM PRINT PALETTE
 1860 ENDPROC
 1870 :
 1880
 1890 DEF PROCdrawmenu
 1900 palcol%=1
 1910 FOR step%=1 TO 15 STEP 2
 1920
 1930   PRINTTAB(step%,0) CHR$(127);CHR$(144+palcol%);CHR$(255);
 1940   palcol%=palcol%+1
 1950 NEXT step%
 1960
 1970 PRINTTAB(14,0);CHR$(135); "PD2 CKB ORLF E LS U A<>PS"
 1980
 1990 ENDPROC
 2000
 2010 DEFPROCc(x%,y%,r%):LOCALA,s,c,x,y,B,s%:A=2*PI/32:s=SINA:c=COSA:x=r%:y=0:MOVEx%+r%,y%:FORs%=1TO128:B=x*c-y*s:y=x*s+y*c:x=B:PROCPLOT(x%+x,y%+y):NEXT:PROCPLOT(x%+r%,y%):ENDPROC
 2020 :
 2030 DEFPROCrectangle(rx%,ry%,rw%,rh%)
 2040 FOR rectcount%=0 TO rw%
 2050   REM Plot the bottom line of the rectangle
 2060   PROCPLOT(rx%+rectcount%,ry%)
 2070   :
 2080   REM Plot the top line of the rectangle
 2090   PROCPLOT(rx%+rectcount%,ry%+rh%)
 2100 NEXT rectcount%
 2110
 2120 :
 2130 REM Plot the sides of the rectangle
 2140 FOR rectcount%=0 TO rh%
 2150   REM Plot the left side of the rectangle
 2160   PROCPLOT(rx%,ry%+rectcount%)
 2170   REM Plot the right side of the rectangle
 2180   PROCPLOT(rx%+rw%,ry%+rectcount%)
 2190 NEXT rectcount%
 2200
 2210
 2220 ENDPROC
 2230
 2240 DEF PROCdrawcol(X%,Y%)
 2250 PROCsave7
 2260 REPEAT
 2270   MOUSE X,Y,Z
 2280   WAIT 100
 2290 UNTIL Z=4
 2300 MOUSE X,Y,Z
 2310
 2320 PRINTTAB(X%,Y%) "a"
 2330 ENDPROC
 2340 :
 2350
 2360 DEF PROCbresenham(x1%,y1%,x2%,y2%)
 2370 LOCAL dx%, dy%, sx%, sy%, e
 2380 dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
 2390 dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
 2400 IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
 2410 REPEAT
 2420   PROCsetpixel(x1%,y1%)
 2430   IF x1% = x2% IF y1% = y2% EXIT REPEAT
 2440   IF dx% > dy% THEN
 2450     x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
 2460   ELSE
 2470     y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
 2480   ENDIF
 2490 UNTIL FALSE
 2500 ENDPROC
 2510
 2520 DEF PROCsetpixel(x%,y%)
 2530
 2540
 2550 PROCPLOT(x%,y%)
 2560 ENDPROC
 2570 ENDPROC
 2580
 2590 DEF PROCdrawcircleroutine
 2600 PROCsave7
 2610
 2620 circenx%=X%:circeny%=Y%:
 2630 REM PRINT    circenx%,circeny%
 2640 REPEAT
 2650   MOUSE X,Y,Z
 2660   WAIT 100
 2670 UNTIL Z=4
 2680 MOUSE X,Y,Z
 2690 X%=(X/17.29)
 2700 xcradiuspos%=X%-circenx%
 2710
 2720 PROCc(circenx%,circeny%,xcradiuspos%)
 2730
 2740 ENDPROC
 2750
 2760 DEF PROCdrawlineroutine
 2770 PROCsave7
 2780 startxline%=X%: startyline%=Y%
 2790 REPEAT
 2800   MOUSE X,Y,Z
 2810   WAIT 100
 2820 UNTIL Z=4
 2830 MOUSE X,Y,Z
 2840 X%=(X/17.29)
 2850 Y%=Y/13.83
 2860
 2870 PROCbresenham(startxline%,startyline%,X%,Y%)
 2880 startxline%=X%: startyline%=Y%
 2890 ENDPROC
 2900
 2910 DEF PROCdrawrectangleroutine
 2920 PROCsave7
 2930 startrecx%=X%:startrecy%=Y%
 2940
 2950
 2960 REPEAT
 2970   MOUSE X,Y,Z
 2980   WAIT 100
 2990 UNTIL Z=4
 3000 MOUSE X,Y,Z
 3010 X%=(X/17.29)
 3020 Y%=Y/13.83
 3030 recwidth%=X%-startrecx%: recheight%=Y%-startrecy%: PROCrectangle(startrecx%,startrecy%,recwidth%,recheight%)
 3040 ENDPROC
 3050 :
 3060
 3070 DEF PROCsavetempscreen
 3080
 3090
 3100 FOR ypos=1 TO 23
 3110   FOR xpos=0 TO 39
 3120     PRINTTAB(30,0);CHR$(135); FNREADCH(xpos,ypos)
 3130     A$=GET$
 3140
 3150   NEXT xpos
 3160 NEXT ypos
 3170 ENDPROC
 3180
 3190
 3200
 3210 DEF PROCsave7
 3220 *HEX 64
 3230 OSCLI "save """ + @tmp$ + "mode7.dat.tmp"" " + STR$~@chrmap% + " +3200"
 3240 ENDPROC
 3250
 3260 DEF PROCload7
 3270 *HEX 64
 3280 OSCLI "load """ + @tmp$ + "mode7.dat.tmp"" " + STR$~@chrmap% + " +3200"
 3290 VDU 23,18,3|
 3300 ENDPROC
 3310
 3320 DEF PROCsavesreentofile
 3330 f%=OPENOUT("m7screedump")
 3340 FOR y%=1 TO 23: FOR x%=0 TO 39
 3350     BPUT#f%,GET$(x%,y%)
 3360   NEXT: NEXT
 3370 CLOSE#f%
 3380 ENDPROC
 3390
 3400 DEF PROCundo
 3410 f%=OPENIN("m7screedump")
 3420
 3430 FOR y%=1 TO 23: FOR x%=0 TO 39
 3440
 3450     char=BGET#f%
 3460     PRINTTAB(x%,y%) CHR$(char);
 3470   NEXT: NEXT
 3480 CLOSE#f%
 3490 ENDPROC
 3500
 3510 DEF PROCbrushstroke
 3520 PROCsave7
 3530 REPEAT
 3540   MOUSE X,Y,Z
 3550   REM PROCdrawcursor
 3560   X%=(X/17.29)
 3570
 3580   Y%=Y/13.83
 3590   CX%= X/32
 3600   CY%= 24-Y/40.96
 3610
 3620   PROCPLOT(X%,Y%)
 3630 UNTIL Z<>4
 3640 IF animation%=1 PROCsavecurrentframe: frame%=frame%+1: PROCloadnextframe
 3650 ENDPROC
 3660
 3670 DEF PROCditherpaint1
 3680
 3690 REPEAT
 3700   MOUSE X,Y,Z
 3710   X%=(X/17.29)
 3720
 3730   Y%=Y/13.83
 3740   CX%= X/32
 3750   CY%= 24-Y/40.96
 3760
 3770   PROCPLOT(X%-2,Y%+4):PROCPLOT(X%-2+1,Y%+4-1)
 3780 UNTIL Z<>4
 3790 ENDPROC
 3800
 3810 DEF PROCditherpaint2
 3820
 3830 REPEAT
 3840   MOUSE X,Y,Z
 3850   X%=(X/16)
 3860
 3870   Y%=Y/13
 3880   CX%= X/32
 3890   CY%= 24-Y/40.96
 3900
 3910   PROCPLOT(X%-2,Y%+4):PROCPLOT(X%-2+4,Y%+4)
 3920 UNTIL Z<>4
 3930 ENDPROC
 3940
 3950 DEF PROCnewpaperbackground
 3960 PROCsave7
 3970 REPEAT
 3980   MOUSE X,Y,Z
 3990   X%=(X/17.29)
 4000
 4010   Y%=Y/13.83
 4020   CX%= X/32
 4030   CY%= 24-Y/40.96
 4040
 4050   PRINTTAB(CX%,CY%) CHR$(135+backcol%);CHR$(157);
 4060 UNTIL Z<>4
 4070 ENDPROC
 4080
 4090 DEF PROCdrawcursor
 4100 PROCsave7paint
 4110 FOR ycount%=0 TO 64
 4120   FOR xcount%=0 TO 73
 4130     PROCPLOT(xcount%,Y%)
 4140   NEXT xcount%
 4150   PROCPLOT(X%,ycount%)
 4160 NEXT ycount%
 4170
 4180 PROCload7paint
 4190 ENDPROC
 4200
 4210 DEF PROCsave7paint
 4220 *HEX 64
 4230 REM OSCLI "save """ + @tmp$ + "mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4240 ENDPROC
 4250
 4260 DEF PROCload7paint
 4270 *HEX 64
 4280 REM OSCLI "load """ + @tmp$ + "mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4290 VDU 23,18,3|
 4300 ENDPROC
 4310
 4320
 4330
 4340 DEF PROCflood(X%, Y%, C%)
 4350 LOCAL L%, R%
 4360 IF POINT(X%,Y%) <> C% ENDPROC
 4370 L% = X%
 4380 R% = X%
 4390 WHILE POINT(L%-2,Y%) = C% : L% -= 2 : ENDWHILE
 4400 WHILE POINT(R%+2,Y%) = C% : R% += 2 : ENDWHILE
 4410 PROCdrawlineroutine(L%,Y%,R%,Y%)
 4420 FOR X% = L% TO R% STEP 2
 4430   PROCflood(X%, Y%+2, C%)
 4440   PROCflood(X%, Y%-2, C%)
 4450 NEXT
 4460 ENDPROC
 4470
 4480 DEF PROCloadnextframe
 4490 *HEX 64
 4500 IF frame%>8 frame%=1
 4510 IF frame%<1 frame%=8
 4520 OSCLI "load """ + @tmp$ + STR$(frame%)+"mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4530 PROCdrawmenu
 4540 VDU 23,18,3|
 4550 ENDPROC
 4560 :
 4570 DEF PROCsavecurrentframe
 4580 *HEX 64
 4590 OSCLI "save """ + @tmp$ + STR$(frame%)+"mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4600 ENDPROC
 4610
 4620
 4630 DEF PROCplay
 4640 REPEAT
 4650   MOUSE X,Y,Z
 4660   X%=(X/17.29)
 4670
 4680   Y%=Y/13.83
 4690   CX%= X/32
 4700   CY%= 24-Y/40.96
 4710
 4720   FOR frame%=1 TO 8
 4730     PROCloadnextframe
 4740     WAIT 20
 4750     PROCdrawmenu
 4760   NEXT frame%
 4770   frame%=1
 4780 UNTIL  FALSE
 4790 ENDPROC
 4800 :
 4810
 4820
 4830 DEF PROCnewpaperbackground
 4840 PROCsave7
 4850 REPEAT
 4860   MOUSE X,Y,Z
 4870   X%=(X/17.29)
 4880
 4890   Y%=Y/13.83
 4900   CX%= X/32
 4910   CY%= 24-Y/40.96
 4920
 4930   PRINTTAB(CX%,CY%) CHR$(135+backcol%);CHR$(157);
 4940 UNTIL Z<>4
 4950 ENDPROC
 4960 :
 4970 DEFFNscreen2m7(x%,y%)
 4980 x%=(x%/16)-2
 4990 y%=(y%/13.3333)
 5000 IF x%<0THENx%=0
 5010 =x%+(y%*256)
 5020
 5030 DEF FNscreen2chr(x%,y%)
 5040 x%=x%/32
 5050 y%=25-(y%/40)
 5060 =x%+(y%*256)
 5070
 5080 :
 5090 REM Using a virtual coordinate system that has 0,0 at the bottom left.
 5100 REM 0,0 corresponds to the bottom line, second character cell
 5110 REM (as it's impossible to put graphics in the left-most cell)
 5120 REM X range is 0 to 77. Y range is 0 to 74 (3 vertical per sixel)
 5130
 5140 DEFFNsxbit(sx%, sy%)
 5150 IF sx% = 0 AND sy% = 0 THEN =16
 5160 IF sx% = 0 AND sy% = 1 THEN =4
 5170 IF sx% = 0 AND sy% = 2 THEN =1
 5180 IF sx% = 1 AND sy% = 0 THEN =64
 5190 IF sx% = 1 AND sy% = 1 THEN =8
 5200 IF sx% = 1 AND sy% = 2 THEN =2
 5210 =0 : REM Catchall
 5220
 5230 DEFFNpoint(x%,y%)
 5240 LOCAL cx%,cy%,chr%,sx%,sy%
 5250 REM Get character cell
 5260 cx% = 1+(x% DIV 2)
 5270 cy% = 24-(y% DIV 3)
 5280 chr%=GET(cx%,cy%) AND &5F
 5290 sx% = x% MOD 2
 5300 sy% = y% MOD 3
 5310 =SGN(chr% AND FNsxbit(sx%,sy%))
 5320
 5330 REM Plot a Teletext sixel point. The first parameter means:
 5340 REM 0: Clear the point
 5350 REM 1: Set the point
 5360 REM 2: Toggle the point
 5370 DEFPROCpoint(yn%, x%, y%)
 5380 LOCAL cx%,cy%,chr%,sx%,sy%,tx%,ty%
 5390 REM Get character cell
 5400 cx% = 1+(x% DIV 2)
 5410 cy% = 24-(y% DIV 3)
 5420 chr%=GET(cx%,cy%) AND &5F
 5430 sx% = x% MOD 2
 5440 sy% = y% MOD 3
 5450 CASE yn% OF
 5460   WHEN 0:chr% AND=(&5F - FNsxbit(sx%,sy%))
 5470   WHEN 1:chr% OR=FNsxbit(sx%,sy%)
 5480   WHEN 2:chr% EOR=FNsxbit(sx%,sy%)
 5490 ENDCASE
 5500 tx%=POS: ty%=VPOS
 5510 PRINT TAB(cx%,cy%)CHR$(chr% OR 160);TAB(tx%,ty%);
 5520 ENDPROC
 5530
 5540
 5550 :
 5560 REM ### flood fill from ART4BBW
 5570 DEF PROCfloodFill(sx%,sy%)
 5580 DIM fill{(100) x%,y%}
 5590
 5600 IF sx%>fxMin% AND sx%<fxMax% AND sy%>fyMin% AND sy%<fyMax% THEN
 5610
 5620   LOCAL uf,df,c%,x%,y%,mc%
 5630   uf=0
 5640   df=0
 5650
 5660   REM fill with mask colour first
 5670   bCnt%=0
 5680   PROCaddFill(sx%,sy%)
 5690
 5700   REPEAT
 5710     REM get next fill point
 5720     bCnt%-=1
 5730     x%=fill{(bCnt%)}.x%
 5740     y%=fill{(bCnt%)}.y%
 5750     IF FNgetpixel(x%,y%) = 0 THEN
 5760
 5770       uf=1 : df=1
 5780
 5790       REM scan left
 5800       WHILE x%>xMin% AND FNgetpixel(x%-1,y%) =0
 5810         x%-=1
 5820       ENDWHILE
 5830
 5840       REM scan right
 5850       WHILE x%<fxMax% AND FNgetpixel(x%,y%) = 0
 5860         PROCsetpixel(x%,y%)
 5870
 5880         REM detect colour changes above and add to list
 5890         IF y%<fyMax% THEN
 5900           c%=FNgetpixel(x%,y%+1)
 5910           IF uf AND c%=0 THEN PROCaddFill(x%,y%+1) : uf=0
 5920           IF c%=1 THEN uf=1
 5930         ENDIF
 5940
 5950         REM detect colour changes below and add to list
 5960         IF y%>fyMin% THEN
 5970           c%=FNgetpixel(x%,y%-1)
 5980           IF df AND c%=0 THEN PROCaddFill(x%,y%-1) : df=0
 5990           IF c%=1 THEN df=1
 6000         ENDIF
 6010         x%+=1
 6020       ENDWHILE
 6030     ENDIF
 6040
 6050   UNTIL bCnt%=0
 6060 ENDIF
 6070 PROCreadmousepos
 6080 ENDPROC
 6090
 6100 REM ### fill quasi stack
 6110
 6120 DEF PROCaddFill(x%,y%)
 6130 fill{(bCnt%)}.x%=x%
 6140 fill{(bCnt%)}.y%=y%
 6150 IF bCnt%<100 THEN bCnt%+=1
 6160 ENDPROC
 6170
 6180 DEF PROCbresenhamf(x1%,y1%,x2%,y2%)
 6190 LOCAL dx%, dy%, sx%, sy%, e
 6200 dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
 6210 dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
 6220 IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
 6230 REPEAT
 6240   PROCsetpixel(x1%,y1%)
 6250   IF x1% = x2% IF y1% = y2% EXIT REPEAT
 6260   IF dx% > dy% THEN
 6270     x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
 6280   ELSE
 6290     y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
 6300   ENDIF
 6310 UNTIL FALSE
 6320 ENDPROC
 6330
 6340 DEF PROCsetpixel(X%,Y%)
 6350 LOCAL p%%,M%
 6360 p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
 6370 M% = (X% AND 1) + (Y% MOD 3) * 2
 6380 IF M% = 5 M% = &40 ELSE M% = 1 << M%
 6390 ?p%% OR= M%
 6400 ENDPROC
 6410
 6420 DEF FNgetpixel(X%,Y%)
 6430 LOCAL p%%,M%
 6440 p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
 6450 M% = (X% AND 1) + (Y% MOD 3) * 2
 6460 IF M% = 5 M% = &40 ELSE M% = 1 << M%
 6470 = ?p%% AND M%
 6480
 6490 :
 6500 DEF PROCPLOT2(X%,Y%)
 6510
 6520 LOCAL C%,A%
 6530
 6540 VDU 31,X% DIV2+1, 24-Y% DIV3
 6550
 6560 C%=S?((X% AND 1)+(2-Y%MOD3) *2)
 6570
 6580 A%=135
 6590
 6600 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 6610
 6620 DEF PROCreadmousepos
 6630 MOUSE X,Y,Z
 6640 X%=(X/17.29)
 6650
 6660 Y%=Y/13.83
 6670 CX%= X/32
 6680 CY%= 24-Y/40.96
 6690 ENDPROC
 6700
 6710 :
 6720 DEFFNscreen2m7(x%,y%)
 6730 x%=(x%/16)-2
 6740 y%=(y%/13.3333)
 6750 IF x%<0THENx%=0
 6760 =x%+(y%*256)
 6770
 6780 DEF FNscreen2chr(x%,y%)
 6790 x%=x%/32
 6800 y%=25-(y%/40)
 6810 =x%+(y%*256)
 6820

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Thu Aug 06, 2020 11:00 pm

Hi Fourthstone ( or anyone ). The program is shaping up now.
I have been stuck for days trying to work out what is wrong with the fill. The fill code is complex.
Basically the fill code (PROCfloodFill) is filling in the wrong areas. So if you at the bottom of the screen it's filling the top. Same for left and right.
Everything needs to be reversed. How do you do that please? It's probably very simple buy my head has been in it for days now. I could sure do with a hand if someone has time. Thanks a lot...the main program is below.

The line here invokes the fill: 1310 IF Z=4 AND Y%>2 AND CY%>1 AND tool$="fill" AND dontpaint%=0 AND CY%>2 VDU 23,18,3|:PROCfloodFill(X%,Y%)
Last edited by pixelblip on Thu Aug 06, 2020 11:00 pm, edited 1 time in total.

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Thu Aug 06, 2020 11:00 pm

Code: Select all

   
10
   20
   30
   40
   50
   60 MODE 7
   70
   80 DIM S 7
   90
  100
  110 !S=&08040201
  120
  130 S!4=&4010
  140
  150 REM 70 Next a row of teletext control codes must be written down the left hand side of the screen to turn every line into a graphics display
  160 backcol%=0
  170 PROCGR
  180 PROCdrawmenu
  190
  200 VDU 23,1,23,39,1
  210
  220
  230 xMin%=2
  240 xMax%=77
  250 yMin%=3
  260 yMax%=74
  270
  280 REM fill bounds
  290 fxMin%=1
  300 fxMax%=78
  310 fyMin%=2
  320 fyMax%=75
  330
  340
  350
  360
  370 REM The main program follows
  380 X=10:Y=73
  390
  400 step%=2
  410 tool$="paint"
  420 MOUSE ON 0
  430 dontpaint%=0
  440 toolsel%=0
  450 circenx%=10
  460 circeny%=10
  470 offsetx%=-2
  480 offsety%=4
  490 col%=1
  500 animation%=0
  510 FOR frame%=1 TO 8
  520   PROCsavecurrentframe
  530 NEXT frame%
  540
  550 REPEAT
  560   REM  PRINTTAB(38,0) frame%;
  570   REM PRINTTAB(14,0) frame%;
  580
  590
  600   MOUSE X,Y,Z
  610   X%=(X/17.29)
  620
  630   Y%=Y/13.83
  640   CX%= X/32
  650   CY%= 24-Y/40.96
  660   IF CX%=1 AND CY%=0 AND Z=4 tool$="colred":col%=1:dontpaint%=1:toolsel%=1 : backcol%=1
  670   IF CX%=3 AND CY%=0  AND Z=4 tool$="colgreen":col%=2:dontpaint%=1 :toolsel%=1:    backcol%=2
  680   IF CX%=5 AND CY%=0  AND Z=4 tool$="colyel":col%=3:dontpaint%=1:toolsel%=1  :    backcol%=3
  690   IF CX%=7 AND CY%=0  AND Z=4 tool$="colblue":col%=4:dontpaint%=1  :toolsel%=1 :    backcol%=4
  700   IF CX%=9 AND CY%=0  AND Z=4 tool$="colmag":col%=5:dontpaint%=1  :toolsel%=1 :     backcol%=5
  710   IF CX%=11 AND CY%=0  AND Z=4 tool$="colcya":col%=6:dontpaint%=1 :toolsel%=1  :       backcol%=6
  720   IF CX%=13 AND CY%=0  AND Z=4 tool$="colwhite":col%=7:dontpaint%=1  :toolsel%=1 :        backcol%=7
  730
  740   IF CX%=15 AND CY%=0 AND Z=4 tool$="paint":dontpaint%=0
  750   IF CX%=16 AND CY%=0 AND Z=4 tool$="ditherpaint":dontpaint%=0
  760   IF CX%=17 AND CY%=0 AND Z=4 tool$="ditherpaintx2":dontpaint%=0
  770
  780   IF CX%=19 AND CY%=0 AND Z=4 tool$="clearscreen":dontpaint%=0:backcol%=0:PROCGR: PROCdrawmenu: backcol%=0: tool$="paint":dontpaint%=0
  790   IF CX%=20 AND CY%=0 AND Z=4 tool$="clearpapercol":dontpaint%=0:PROCGR:PROCdrawmenu: WAIT 50: backcol%=0: tool$="paint":dontpaint%=0
  800   IF CX%=21 AND CY%=0 AND Z=4 tool$="papercol":dontpaint%=0:
  810   IF CX%=23 AND CY%=0 AND Z=4 tool$="circle":dontpaint%=0:oswitch%=1
  820
  830   IF CX%=24 AND CY%=0 AND Z=4 tool$="rectangle":dontpaint%=0:
  840   IF CX%=25 AND CY%=0 AND Z=4 tool$="line":dontpaint%=0:
  850   IF CX%=26 AND CY%=0 AND Z=4 tool$="fill":dontpaint%=0: tool$="fill":dontpaint%=0
  860   IF CX%=27 AND CY%=0 AND Z=4 tool$="eraser":dontpaint%=0:
  870   IF CX%=28 AND CY%=0 AND Z=4 tool$="eraser":dontpaint%=2:
  880
  890   REM IF CX%=33 AND CY%=0 AND Z=4 temptool$=tool$: tool$="undo":PROCload7:tool$=temptool$
  900   IF CX%=35 AND CY%=0 AND Z=4 animation%=1
  910   IF CX%=36 AND CY%=0 AND Z=4 frame%=frame%-1: PROCloadnextframe
  920   IF CX%=37 AND CY%=0 AND Z=4 frame%=frame%+1: PROCloadnextframe
  930   IF CX%=38 AND CY%=0 AND Z=4 PROCplay
  940   IF CX%=31 AND CY%=0 AND Z=4 tool$="save":dontpaint%=2: PROCsavepic
  950   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="eraser" AND dontpaint%=2 AND CY%>2 PROCpoint(0,X%,Y%)
  960
  970
  980
  990   PRINTTAB(38,0)  CHR$(144+col%);CHR$(255);
 1000
 1010
 1020
 1030
 1040
 1050
 1060
 1070
 1080
 1090
 1100
 1110
 1120
 1130
 1140   REM PROCdrawcursor
 1150
 1160   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="paint" PROCbrushstroke
 1170
 1180   IF Z=4 AND Y%>2 AND CY%>1 AND dontpaint%=1 PROCbrushstroke
 1190   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="eraser" AND dontpaint%=0 AND CY%>2 PROCsave7: PRINTTAB(X/32,24-(Y/40.96)) " ";  :WAIT 20
 1200   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="ditherpaint" AND X% MOD 2=0 AND Y% MOD 2=0   PROCditherpaint1
 1210   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="ditherpaint2" AND X% MOD 2=0 AND Y% MOD 2=0   PROCditherpaint2
 1220   IF Z=4 AND CY%>0 AND tool$="circle" AND dontpaint%=0 PROCdrawcircleroutine
 1230   IF Z=4 AND CY%>0 AND tool$="papercol" AND dontpaint%=0 PROCnewpaperbackground
 1240   IF Z=4 AND dontpaint%=1  AND tool$="col" PROCdrawcol(X%,Y%)
 1250
 1260
 1270
 1280   IF Z=4 AND  CY%>0 AND tool$="rectangle" AND dontpaint%=0 PROCdrawrectangleroutine
 1290
 1300   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="line" AND dontpaint%=0 AND CY%>2 PROCsave7:PROCdrawlineroutine

 1310   IF Z=4 AND Y%>2 AND CY%>1 AND tool$="fill" AND dontpaint%=0 AND CY%>2 VDU 23,18,3|:PROCfloodFill(X%,Y%)
 1320
 1330
 1340
 1350
 1360
 1370
 1380 UNTIL FALSE
 1390
 1400 END
 1410
 1420 REM and lastly here is the procedure to plot the point
 1430
 1440 DEF PROCPLOT(X%,Y%)
 1450
 1460 LOCAL C%,A%
 1470
 1480 VDU 31,X% DIV2+1, 24-Y% DIV3
 1490
 1500 C%=S?((X% AND 1)+(2-Y%MOD3) *2)
 1510
 1520 A%=135
 1530
 1540 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 1550
 1560
 1570 ENDPROC
 1580
 1590 DEF PROCERASE(X%,Y%)
 1600
 1610 LOCAL C%,A%
 1620
 1630 VDU 31,X% DIV2+1, 24-Y% DIV3
 1640
 1650 C%=S%?((X% AND 1)+(2-Y%MOD3) *2)
 1660
 1670 A%=133
 1680
 1690 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 1700
 1710 ENDPROC
 1720
 1730
 1740 DEF PROCGR
 1750
 1760
 1770
 1780 VDU 12
 1790
 1800 FOR counter%=1 TO 23
 1810   IF backcol%>0 PRINTTAB(0,counter%) CHR$(128+backcol%);CHR$(157);CHR$(151)
 1820   IF backcol%=0 VDU 10,13,&97
 1830
 1840 NEXT counter%
 1850 REM PRINT PALETTE
 1860 ENDPROC
 1870 :
 1880
 1890 DEF PROCdrawmenu
 1900 palcol%=1
 1910 FOR step%=1 TO 15 STEP 2
 1920
 1930   PRINTTAB(step%,0) CHR$(127);CHR$(144+palcol%);CHR$(255);
 1940   palcol%=palcol%+1
 1950 NEXT step%
 1960
 1970 PRINTTAB(14,0);CHR$(135); "PD2 CKB ORLF E LS U A<>PS"
 1980
 1990 ENDPROC
 2000
 2010 DEFPROCc(x%,y%,r%):LOCALA,s,c,x,y,B,s%:A=2*PI/32:s=SINA:c=COSA:x=r%:y=0:MOVEx%+r%,y%:FORs%=1TO128:B=x*c-y*s:y=x*s+y*c:x=B:PROCPLOT(x%+x,y%+y):NEXT:PROCPLOT(x%+r%,y%):ENDPROC
 2020 :
 2030 DEFPROCrectangle(rx%,ry%,rw%,rh%)
 2040 FOR rectcount%=0 TO rw%
 2050   REM Plot the bottom line of the rectangle
 2060   PROCPLOT(rx%+rectcount%,ry%)
 2070   :
 2080   REM Plot the top line of the rectangle
 2090   PROCPLOT(rx%+rectcount%,ry%+rh%)
 2100 NEXT rectcount%
 2110
 2120 :
 2130 REM Plot the sides of the rectangle
 2140 FOR rectcount%=0 TO rh%
 2150   REM Plot the left side of the rectangle
 2160   PROCPLOT(rx%,ry%+rectcount%)
 2170   REM Plot the right side of the rectangle
 2180   PROCPLOT(rx%+rw%,ry%+rectcount%)
 2190 NEXT rectcount%
 2200
 2210
 2220 ENDPROC
 2230
 2240 DEF PROCdrawcol(X%,Y%)
 2250 PROCsave7
 2260 REPEAT
 2270   MOUSE X,Y,Z
 2280   WAIT 100
 2290 UNTIL Z=4
 2300 MOUSE X,Y,Z
 2310
 2320 PRINTTAB(X%,Y%) "a"
 2330 ENDPROC
 2340 :
 2350
 2360 DEF PROCbresenham(x1%,y1%,x2%,y2%)
 2370 LOCAL dx%, dy%, sx%, sy%, e
 2380 dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
 2390 dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
 2400 IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
 2410 REPEAT
 2420   PROCsetpixel(x1%,y1%)
 2430   IF x1% = x2% IF y1% = y2% EXIT REPEAT
 2440   IF dx% > dy% THEN
 2450     x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
 2460   ELSE
 2470     y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
 2480   ENDIF
 2490 UNTIL FALSE
 2500 ENDPROC
 2510
 2520 DEF PROCsetpixel(x%,y%)
 2530
 2540
 2550 PROCPLOT(x%,y%)
 2560 ENDPROC
 2570 ENDPROC
 2580
 2590 DEF PROCdrawcircleroutine
 2600 PROCsave7
 2610
 2620 circenx%=X%:circeny%=Y%:
 2630 REM PRINT    circenx%,circeny%
 2640 REPEAT
 2650   MOUSE X,Y,Z
 2660   WAIT 100
 2670 UNTIL Z=4
 2680 MOUSE X,Y,Z
 2690 X%=(X/17.29)
 2700 xcradiuspos%=X%-circenx%
 2710
 2720 PROCc(circenx%,circeny%,xcradiuspos%)
 2730
 2740 ENDPROC
 2750
 2760 DEF PROCdrawlineroutine
 2770 PROCsave7
 2780 startxline%=X%: startyline%=Y%
 2790 REPEAT
 2800   MOUSE X,Y,Z
 2810   WAIT 100
 2820 UNTIL Z=4
 2830 MOUSE X,Y,Z
 2840 X%=(X/17.29)
 2850 Y%=Y/13.83
 2860
 2870 PROCbresenham(startxline%,startyline%,X%,Y%)
 2880 startxline%=X%: startyline%=Y%
 2890 ENDPROC
 2900
 2910 DEF PROCdrawrectangleroutine
 2920 PROCsave7
 2930 startrecx%=X%:startrecy%=Y%
 2940
 2950
 2960 REPEAT
 2970   MOUSE X,Y,Z
 2980   WAIT 100
 2990 UNTIL Z=4
 3000 MOUSE X,Y,Z
 3010 X%=(X/17.29)
 3020 Y%=Y/13.83
 3030 recwidth%=X%-startrecx%: recheight%=Y%-startrecy%: PROCrectangle(startrecx%,startrecy%,recwidth%,recheight%)
 3040 ENDPROC
 3050 :
 3060
 3070 DEF PROCsavetempscreen
 3080
 3090
 3100 FOR ypos=1 TO 23
 3110   FOR xpos=0 TO 39
 3120     PRINTTAB(30,0);CHR$(135); FNREADCH(xpos,ypos)
 3130     A$=GET$
 3140
 3150   NEXT xpos
 3160 NEXT ypos
 3170 ENDPROC
 3180
 3190
 3200
 3210 DEF PROCsave7
 3220 *HEX 64
 3230 OSCLI "save """ + @tmp$ + "mode7.dat.tmp"" " + STR$~@chrmap% + " +3200"
 3240 ENDPROC
 3250
 3260 DEF PROCload7
 3270 *HEX 64
 3280 OSCLI "load """ + @tmp$ + "mode7.dat.tmp"" " + STR$~@chrmap% + " +3200"
 3290 VDU 23,18,3|
 3300 ENDPROC
 3310
 3320 DEF PROCsavesreentofile
 3330 f%=OPENOUT("m7screedump")
 3340 FOR y%=1 TO 23: FOR x%=0 TO 39
 3350     BPUT#f%,GET$(x%,y%)
 3360   NEXT: NEXT
 3370 CLOSE#f%
 3380 ENDPROC
 3390
 3400 DEF PROCundo
 3410 f%=OPENIN("m7screedump")
 3420
 3430 FOR y%=1 TO 23: FOR x%=0 TO 39
 3440
 3450     char=BGET#f%
 3460     PRINTTAB(x%,y%) CHR$(char);
 3470   NEXT: NEXT
 3480 CLOSE#f%
 3490 ENDPROC
 3500
 3510 DEF PROCbrushstroke
 3520 PROCsave7
 3530 REPEAT
 3540   MOUSE X,Y,Z
 3550   REM PROCdrawcursor
 3560   X%=(X/17.29)
 3570
 3580   Y%=Y/13.83
 3590   CX%= X/32
 3600   CY%= 24-Y/40.96
 3610
 3620   PROCPLOT(X%,Y%)
 3630 UNTIL Z<>4
 3640 IF animation%=1 PROCsavecurrentframe: frame%=frame%+1: PROCloadnextframe
 3650 ENDPROC
 3660
 3670 DEF PROCditherpaint1
 3680
 3690 REPEAT
 3700   MOUSE X,Y,Z
 3710   X%=(X/17.29)
 3720
 3730   Y%=Y/13.83
 3740   CX%= X/32
 3750   CY%= 24-Y/40.96
 3760
 3770   PROCPLOT(X%-2,Y%+4):PROCPLOT(X%-2+1,Y%+4-1)
 3780 UNTIL Z<>4
 3790 ENDPROC
 3800
 3810 DEF PROCditherpaint2
 3820
 3830 REPEAT
 3840   MOUSE X,Y,Z
 3850   X%=(X/16)
 3860
 3870   Y%=Y/13
 3880   CX%= X/32
 3890   CY%= 24-Y/40.96
 3900
 3910   PROCPLOT(X%-2,Y%+4):PROCPLOT(X%-2+4,Y%+4)
 3920 UNTIL Z<>4
 3930 ENDPROC
 3940
 3950 DEF PROCnewpaperbackground
 3960 PROCsave7
 3970 REPEAT
 3980   MOUSE X,Y,Z
 3990   X%=(X/17.29)
 4000
 4010   Y%=Y/13.83
 4020   CX%= X/32
 4030   CY%= 24-Y/40.96
 4040
 4050   PRINTTAB(CX%,CY%) CHR$(135+backcol%);CHR$(157);
 4060 UNTIL Z<>4
 4070 ENDPROC
 4080
 4090 DEF PROCdrawcursor
 4100 PROCsave7paint
 4110 FOR ycount%=0 TO 64
 4120   FOR xcount%=0 TO 73
 4130     PROCPLOT(xcount%,Y%)
 4140   NEXT xcount%
 4150   PROCPLOT(X%,ycount%)
 4160 NEXT ycount%
 4170
 4180 PROCload7paint
 4190 ENDPROC
 4200
 4210 DEF PROCsave7paint
 4220 *HEX 64
 4230 REM OSCLI "save """ + @tmp$ + "mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4240 ENDPROC
 4250
 4260 DEF PROCload7paint
 4270 *HEX 64
 4280 REM OSCLI "load """ + @tmp$ + "mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4290 VDU 23,18,3|
 4300 ENDPROC
 4310
 4320
 4330
 4340 DEF PROCflood(X%, Y%, C%)
 4350 LOCAL L%, R%
 4360 IF POINT(X%,Y%) <> C% ENDPROC
 4370 L% = X%
 4380 R% = X%
 4390 WHILE POINT(L%-2,Y%) = C% : L% -= 2 : ENDWHILE
 4400 WHILE POINT(R%+2,Y%) = C% : R% += 2 : ENDWHILE
 4410 PROCdrawlineroutine(L%,Y%,R%,Y%)
 4420 FOR X% = L% TO R% STEP 2
 4430   PROCflood(X%, Y%+2, C%)
 4440   PROCflood(X%, Y%-2, C%)
 4450 NEXT
 4460 ENDPROC
 4470
 4480 DEF PROCloadnextframe
 4490 *HEX 64
 4500 IF frame%>8 frame%=1
 4510 IF frame%<1 frame%=8
 4520 OSCLI "load """ + @tmp$ + STR$(frame%)+"mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4530 PROCdrawmenu
 4540 VDU 23,18,3|
 4550 ENDPROC
 4560 :
 4570 DEF PROCsavecurrentframe
 4580 *HEX 64
 4590 OSCLI "save """ + @tmp$ + STR$(frame%)+"mode7paint.dat.tmp"" " + STR$~@chrmap% + " +3200"
 4600 ENDPROC
 4610
 4620
 4630 DEF PROCplay
 4640 REPEAT
 4650   MOUSE X,Y,Z
 4660   X%=(X/17.29)
 4670
 4680   Y%=Y/13.83
 4690   CX%= X/32
 4700   CY%= 24-Y/40.96
 4710
 4720   FOR frame%=1 TO 8
 4730     PROCloadnextframe
 4740     WAIT 20
 4750     PROCdrawmenu
 4760   NEXT frame%
 4770   frame%=1
 4780 UNTIL  FALSE
 4790 ENDPROC
 4800 :
 4810
 4820
 4830 DEF PROCnewpaperbackground
 4840 PROCsave7
 4850 REPEAT
 4860   MOUSE X,Y,Z
 4870   X%=(X/17.29)
 4880
 4890   Y%=Y/13.83
 4900   CX%= X/32
 4910   CY%= 24-Y/40.96
 4920
 4930   PRINTTAB(CX%,CY%) CHR$(135+backcol%);CHR$(157);
 4940 UNTIL Z<>4
 4950 ENDPROC
 4960 :
 4970 DEFFNscreen2m7(x%,y%)
 4980 x%=(x%/16)-2
 4990 y%=(y%/13.3333)
 5000 IF x%<0THENx%=0
 5010 =x%+(y%*256)
 5020
 5030 DEF FNscreen2chr(x%,y%)
 5040 x%=x%/32
 5050 y%=25-(y%/40)
 5060 =x%+(y%*256)
 5070
 5080 :
 5090 REM Using a virtual coordinate system that has 0,0 at the bottom left.
 5100 REM 0,0 corresponds to the bottom line, second character cell
 5110 REM (as it's impossible to put graphics in the left-most cell)
 5120 REM X range is 0 to 77. Y range is 0 to 74 (3 vertical per sixel)
 5130
 5140 DEFFNsxbit(sx%, sy%)
 5150 IF sx% = 0 AND sy% = 0 THEN =16
 5160 IF sx% = 0 AND sy% = 1 THEN =4
 5170 IF sx% = 0 AND sy% = 2 THEN =1
 5180 IF sx% = 1 AND sy% = 0 THEN =64
 5190 IF sx% = 1 AND sy% = 1 THEN =8
 5200 IF sx% = 1 AND sy% = 2 THEN =2
 5210 =0 : REM Catchall
 5220
 5230 DEFFNpoint(x%,y%)
 5240 LOCAL cx%,cy%,chr%,sx%,sy%
 5250 REM Get character cell
 5260 cx% = 1+(x% DIV 2)
 5270 cy% = 24-(y% DIV 3)
 5280 chr%=GET(cx%,cy%) AND &5F
 5290 sx% = x% MOD 2
 5300 sy% = y% MOD 3
 5310 =SGN(chr% AND FNsxbit(sx%,sy%))
 5320
 5330 REM Plot a Teletext sixel point. The first parameter means:
 5340 REM 0: Clear the point
 5350 REM 1: Set the point
 5360 REM 2: Toggle the point
 5370 DEFPROCpoint(yn%, x%, y%)
 5380 LOCAL cx%,cy%,chr%,sx%,sy%,tx%,ty%
 5390 REM Get character cell
 5400 cx% = 1+(x% DIV 2)
 5410 cy% = 24-(y% DIV 3)
 5420 chr%=GET(cx%,cy%) AND &5F
 5430 sx% = x% MOD 2
 5440 sy% = y% MOD 3
 5450 CASE yn% OF
 5460   WHEN 0:chr% AND=(&5F - FNsxbit(sx%,sy%))
 5470   WHEN 1:chr% OR=FNsxbit(sx%,sy%)
 5480   WHEN 2:chr% EOR=FNsxbit(sx%,sy%)
 5490 ENDCASE
 5500 tx%=POS: ty%=VPOS
 5510 PRINT TAB(cx%,cy%)CHR$(chr% OR 160);TAB(tx%,ty%);
 5520 ENDPROC
 5530
 5540
 5550 :
 5560 REM ### flood fill from ART4BBW
 5570 DEF PROCfloodFill(sx%,sy%)
 5580 DIM fill{(100) x%,y%}
 5590
 5600 IF sx%>fxMin% AND sx%<fxMax% AND sy%>fyMin% AND sy%<fyMax% THEN
 5610
 5620   LOCAL uf,df,c%,x%,y%,mc%
 5630   uf=0
 5640   df=0
 5650
 5660   REM fill with mask colour first
 5670   bCnt%=0
 5680   PROCaddFill(sx%,sy%)
 5690
 5700   REPEAT
 5710     REM get next fill point
 5720     bCnt%-=1
 5730     x%=fill{(bCnt%)}.x%
 5740     y%=fill{(bCnt%)}.y%
 5750     IF FNgetpixel(x%,y%) = 0 THEN
 5760
 5770       uf=1 : df=1
 5780
 5790       REM scan left
 5800       WHILE x%>xMin% AND FNgetpixel(x%-1,y%) =0
 5810         x%-=1
 5820       ENDWHILE
 5830
 5840       REM scan right
 5850       WHILE x%<fxMax% AND FNgetpixel(x%,y%) = 0
 5860         PROCsetpixel(x%,y%)
 5870
 5880         REM detect colour changes above and add to list
 5890         IF y%<fyMax% THEN
 5900           c%=FNgetpixel(x%,y%+1)
 5910           IF uf AND c%=0 THEN PROCaddFill(x%,y%+1) : uf=0
 5920           IF c%=1 THEN uf=1
 5930         ENDIF
 5940
 5950         REM detect colour changes below and add to list
 5960         IF y%>fyMin% THEN
 5970           c%=FNgetpixel(x%,y%-1)
 5980           IF df AND c%=0 THEN PROCaddFill(x%,y%-1) : df=0
 5990           IF c%=1 THEN df=1
 6000         ENDIF
 6010         x%+=1
 6020       ENDWHILE
 6030     ENDIF
 6040
 6050   UNTIL bCnt%=0
 6060 ENDIF
 6070 PROCreadmousepos
 6080 ENDPROC
 6090
 6100 REM ### fill quasi stack
 6110
 6120 DEF PROCaddFill(x%,y%)
 6130 fill{(bCnt%)}.x%=x%
 6140 fill{(bCnt%)}.y%=y%
 6150 IF bCnt%<100 THEN bCnt%+=1
 6160 ENDPROC
 6170
 6180 DEF PROCbresenhamf(x1%,y1%,x2%,y2%)
 6190 LOCAL dx%, dy%, sx%, sy%, e
 6200 dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
 6210 dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
 6220 IF dx% > dy% e = dx% / 2 ELSE e = dy% / 2
 6230 REPEAT
 6240   PROCsetpixel(x1%,y1%)
 6250   IF x1% = x2% IF y1% = y2% EXIT REPEAT
 6260   IF dx% > dy% THEN
 6270     x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
 6280   ELSE
 6290     y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
 6300   ENDIF
 6310 UNTIL FALSE
 6320 ENDPROC
 6330
 6340 DEF PROCsetpixel(X%,Y%)
 6350 LOCAL p%%,M%
 6360 p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
 6370 M% = (X% AND 1) + (Y% MOD 3) * 2
 6380 IF M% = 5 M% = &40 ELSE M% = 1 << M%
 6390 ?p%% OR= M%
 6400 ENDPROC
 6410
 6420 DEF FNgetpixel(X%,Y%)
 6430 LOCAL p%%,M%
 6440 p%% = @chrmap% + (X% AND NOT 1) + ((Y% DIV 3) << 9)
 6450 M% = (X% AND 1) + (Y% MOD 3) * 2
 6460 IF M% = 5 M% = &40 ELSE M% = 1 << M%
 6470 = ?p%% AND M%
 6480
 6490 :
 6500 DEF PROCPLOT2(X%,Y%)
 6510
 6520 LOCAL C%,A%
 6530
 6540 VDU 31,X% DIV2+1, 24-Y% DIV3
 6550
 6560 C%=S?((X% AND 1)+(2-Y%MOD3) *2)
 6570
 6580 A%=135
 6590
 6600 VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
 6610
 6620 DEF PROCreadmousepos
 6630 MOUSE X,Y,Z
 6640 X%=(X/17.29)
 6650
 6660 Y%=Y/13.83
 6670 CX%= X/32
 6680 CY%= 24-Y/40.96
 6690 ENDPROC
 6700
 6710 :
 6720 DEFFNscreen2m7(x%,y%)
 6730 x%=(x%/16)-2
 6740 y%=(y%/13.3333)
 6750 IF x%<0THENx%=0
 6760 =x%+(y%*256)
 6770
 6780 DEF FNscreen2chr(x%,y%)
 6790 x%=x%/32
 6800 y%=25-(y%/40)
 6810 =x%+(y%*256)
 6820

Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Thu Aug 06, 2020 11:26 pm

A couple of things I've spotted about the code generally...
Line 6500, in PROCPLOT2, there is no ENDPROC. Suggest you add:
6610 ENDPROC

Some functions and procedures are defined twice,
FNscreen2m7 at lines 6720 and 4970
FNscreen2chr at lines 6780 and 5030
PROCnewpaperbackground at lines 3950 and 4830
PROCsetpixel at lines 2520 and 6340
Matrix Brandy BASIC VI (work in progress)

User avatar
FourthStone
Posts: 949
Joined: Thu Nov 17, 2016 2:29 am
Location: Brisbane, Australia
Contact:

Re: Teletext paint program

Post by FourthStone » Fri Aug 07, 2020 12:11 am

I haven't run it yet as I'm at work but this line here must be at the start of the program...

Remove this:
5580 DIM fill{(100) x%,y%}

Add this:
340 DIM fill{(100) x%,y%}

Otherwise will run the code as soon as I can and see if I can work out why fill is reversed :-k

User avatar
FourthStone
Posts: 949
Joined: Thu Nov 17, 2016 2:29 am
Location: Brisbane, Australia
Contact:

Re: Teletext paint program

Post by FourthStone » Fri Aug 07, 2020 12:36 am

I think the main loop can be improved in terms of logic layout and performance and I'll have a go at it this weekend. I notice there is quite a lot of lag and I think re-organising the main loop will make it more smooth.

Agree with Richard that there is no need to use fractional division to convert mouse coords into screen coords and I feel that is where some of the ambiguity comes from when drawing / filling etc.

I want to take a closer looks at that the way the colours are used in that a colour change on a line of Mode7 takes up a character space which changes all pixels after the code until a different code is encountered or the end of the line, I think separating pixel drawing from colour or other line codes would be more intuitive way to use the colour codes.

Just thoughts for now and I'm sure I'll have many challenges and compromises to make.

Really good effort so far Pixel =D>

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Fri Aug 07, 2020 7:31 am

pixelblip wrote:
Thu Aug 06, 2020 10:59 pm
I could sure do with a hand if someone has time.
Since (I believe) you are using BBC BASIC for SDL 2.0 can I suggest that you get into the habit of running the supplied Cross Reference utility, which can be found in the Utilities menu (it's available in BBC BASIC for Windows too). I find this useful for spotting some common programming mistakes, for example it will notice that you have multiple procedures with the same name:

crossref.png

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Fri Aug 07, 2020 8:58 am

Thank you Richard and Fourthstone.
Sorry I have to apologise the code is messy I know. I was just rushing to get it posted in the hope we could get fill going and I could get painting!
I've had to cut and paste quite a bit and go through different versions and I got in a right muddle. Sorry :)

As for fractions Fourthstone yes I did remove those at one point so X%=X/17 and Y%=Y/13 ( which divides the mouse cursor position) . Sorry I should have changed that.

I agree there is lag and it is very clunky the whole thing.
One thing on another note I was thinking about was animation. I've got that going now to a certain degree. 8 frames. You can go back and forth. I tested also loading a screen into a teletext editor online and that worked which is great as I am not sure I will add text to the program as it's chiefly a drawing program.

The other thing I have to think about is if you put colour into the picture and do animation the colour might get ruined. That is interesting to think about. I think I will have to design it so I have a main template which just consists of colour and then for every frame it draws the colour over the top. I've been thinking about that a lot.

The circle routine isn't very good at the moment so I need to look at that. It draws dotted circles! The Rectangle draws only one way. The linedrawing routine is slightly out to the cursor.

So lots to do.
Mike

User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Fri Aug 07, 2020 10:08 am

pixelblip wrote:
Fri Aug 07, 2020 8:58 am
Sorry I have to apologise the code is messy I know. I was just rushing to get it posted in the hope we could get fill going and I could get painting!
I do sympathise, and I would not want to dampen your enthusiasm. But the fact is that a poorly-structured program ("messy" in your words) is going to be much harder to debug and to get working reliably. You will discover, with experience, that keeping your code 'clean' will save time and frustration in the long run.

Coding practices like information hiding and encapsulation, favoured by advocates of structured programming, may seem like an unwelcome overhead to you at the moment, but in time you will learn that they offer practical benefits.

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Fri Aug 07, 2020 12:02 pm

That is a fair enough comment Richard and if I am asking for help I should at the very least tidy things up so people can help.
I will have a bash this weekend just to make it more readable. You are totally right.....

Soruk
Posts: 774
Joined: Mon Jul 09, 2018 11:31 am
Location: Basingstoke, Hampshire
Contact:

Re: Teletext paint program

Post by Soruk » Fri Aug 07, 2020 12:05 pm

pixelblip wrote:
Fri Aug 07, 2020 12:02 pm
That is a fair enough comment Richard and if I am asking for help I should at the very least tidy things up so people can help.
I will have a bash this weekend just to make it more readable. You are totally right.....
It's also to help you. When you come back to this code in several months' time, if it's well structured (and I would recommend the liberal use of REM statements to document what different bits do) it will be far easier to remind yourself of what the heck that bit of code is supposed to be doing. PROCc (line 2010) is a good example of why that would be helpful.
Matrix Brandy BASIC VI (work in progress)

User avatar
pixelblip
Posts: 1931
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Fri Aug 07, 2020 8:00 pm

Yes you are right. PROCc. Dear oh dear!

User avatar
FourthStone
Posts: 949
Joined: Thu Nov 17, 2016 2:29 am
Location: Brisbane, Australia
Contact:

Re: Teletext paint program

Post by FourthStone » Fri Aug 07, 2020 11:13 pm

Had a look at the core loop, which to me is defining accurate mouse tracking and accurate plotting of pixels in mode 7.

So... here is the first stage of that effort which is a simple loop to track the mouse and plot and un-plot a pixel.

I made changes to the plot procedure so you need to keep that in mind if you are going to use my code. I made the pixel coordinates align with the text screen as to me it feels more intuitive. It could be modified back to 0,0 at bottom left but I found it just makes more sense having 0,0 at the top left to align with the text coordinates.

The other change I made to the plot routine was the ability to switch on or off a single pixel.

There are no draw routines just yet, I really wanted to flesh out a core loop with accurate mouse tracking and that is what we have below.

I'll see if I get time to add some of the drawing elements in so that you have a base that you can easily add more to.

Code: Select all

      MODE 7

      REM TURN OFF CURSOR
      VDU 23,1,0;0;0;0;

      REM LOOKUP CODES FOR TELETEXT GRAPHICS CHARS
      DIM S% 7

      !S%=&08040201

      S%!4=&4010


      MOUSE ON 0

      PROCGR

      OLD_PX%=0
      OLD_PY%=0

      OLD_MX%=0
      OLD_MY%=0

      REPEAT
        MOUSE X,Y,Z
        IF X<>OLD_MX% OR Y<>OLD_MY% THEN
          TX%=X DIV 32
          TY%=(999-Y) DIV 40

          PX%=X DIV 16
          PY%=(999-Y)/13.3333333

          PRINTTAB(0,0)SPC(40)
          PRINTTAB(0,0)"MX:";STR$(X);" MY:";STR$(Y);" TX:";STR$(TX%);" TY:";STR$(TY%);" PX:";STR$(PX%);" PY:";STR$(PY%)

          IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
            IF OLD_PX%>1 AND OLD_PX%<80 AND OLD_PY%>2 AND OLD_PY%<75 THEN
              PROCPLOT(OLD_PX%,OLD_PY%,0)
            ENDIF

            OLD_PX%=PX%
            OLD_PY%=PY%

            IF OLD_PX%>1 AND OLD_PX%<80 AND OLD_PY%>2 AND OLD_PY%<75 THEN
              PROCPLOT(OLD_PX%,OLD_PY%,1)
            ENDIF

          ENDIF

          OLD_MX%=X
          OLD_MY%=Y

        ELSE
          WAIT 2
        ENDIF

      UNTIL 0

      END


      DEF PROCPLOT(X%,Y%,D%)

      LOCAL C%,A%

      VDU 31,X% DIV2, Y% DIV3

      C%=S%?((X% AND 1)+(Y%MOD3) *2)

      A%=135

      IF D% THEN
        VDU (USR &FFF4 AND &FF00) DIV256 OR C% OR 128
      ELSE
        VDU (USR &FFF4 AND &FF00) DIV256 -C% OR 128
      ENDIF

      ENDPROC

      DEF PROCGR

      REM CLS
      VDU 12

      REM ADD GRAPHICS CODE TO LEFT SIDE OF CANVAS
      FOR Y%=1 TO 24
        PRINTTAB(0,Y%) CHR$(145+Y% MOD7);CHR$(255);
      NEXT

      REM PRINT PALETTE, NO NEED TO PRINT BLACK
      FOR count%=1 TO 7
        PRINTTAB(count%*4-3,0) CHR$(144+count%);CHR$(255);CHR$(255);
      NEXT count%
      PRINTTAB(29,0) CHR$(135);"PDCLS"

      ENDPROC


User avatar
Richard Russell
Posts: 1595
Joined: Sun Feb 27, 2011 10:35 am
Location: Downham Market, Norfolk
Contact:

Re: Teletext paint program

Post by Richard Russell » Sat Aug 08, 2020 12:05 am

FourthStone wrote:
Fri Aug 07, 2020 11:13 pm
So... here is the first stage of that effort which is a simple loop to track the mouse and plot and un-plot a pixel.

Code: Select all

      MODE 7

      REM TURN OFF CURSOR
      VDU 23,1,0;0;0;0;

      REM LOOKUP CODES FOR TELETEXT GRAPHICS CHARS
      DIM S% 7

      !S%=&08040201

      S%!4=&4010
As noted earlier in the thread, using S% to hold a pointer won't work in BBC BASIC for SDL 2.0 or Matrix Brandy when running on a 64-bit platform. You need to use S%% or plain S (I prefer the latter because it maintains compatibility with earlier versions of BBC BASIC). Alternatively you could use a regular array rather than indirection to avoid the problem altogether:

Code: Select all

      DIM S%(5)
      S%() = &01,&02,&04,&08,&10,&40
If you're targetting only BB4W, BBCSDL or Matrix Brandy you could use a byte array, but again this introduces an incompatibility with earlier versions and the memory saving is insignificant (6 bytes rather than 24):

Code: Select all

      DIM S&(5)
      S&() = &01,&02,&04,&08,&10,&40

Post Reply

Return to “programming”