Teletext paint program

bbc micro/electron/atom/risc os coding queries and routines
User avatar
pixelblip
Posts: 2222
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Re: Teletext paint program

Post by pixelblip » Sat Aug 22, 2020 11:41 pm

What would be neat is getting the pics to save to google drive....it’s ok on the iPad but you have to use iTunes to retrieve I believe....just a limitation of it.
Apple sure lock it down.
What is exciting is this art program could be turned into an .apk for Android quite easily.
I have to confess I do like iPads. I feel the aspect ratio of an iPad at 4:3 is very similar to a Beeb. It feels right in the hand and iPads have a certain solidness to them I can’t explain.

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

Re: Teletext paint program

Post by FourthStone » Sun Aug 23, 2020 5:22 am

Would be happy to add save to cloud if someone can point the way, might have a look through some of the demo programs to see if there are any idea's in there.

Posted another quick update above, added whole char drawing with erase, and erase for line, rectangle and circle.

Enjoying the pics so far =D> :D

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 7:22 am

Well done for adding even more. Amazing. So useful to be able to delete with a line.
You were right to start the core program from scratch. It makes adding more features much easier and quicker.
I am not sure if Richard can be much help about adding save to google drive as I had asked him before...maybe someone else has done it before and can help. It would be very useful indeed.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 7:59 am

The clear frames tool is so well implemented. I love what you have done.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:17 am

It’s very natural to paint with using just your finger
Attachments
B92B7475-EBB4-4A6E-B768-AF68230E8DFF.jpeg

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:19 am

There are times when painting background at the top introduces weirdness...just one line of it...sometimes the picture also scrolls up vertically if you are at the bottom painting background colours on the extreme left.
Attachments
1FC01C13-06E6-4819-82D9-8A331F096AE2.png

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:21 am

You have to admit the teletext pics are so different to anything else it is such a cool medium. I love the fact the mistakes look glitchy and cool.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:24 am

For others following the thread look at the clear background tool. It is very well implemented. You are a great programmer Fourthstone! It is a joint effort from us all of course. Everyone has helped immensely.

This is shaping up to be the best teletext editor I have used to date. For artists anyway. I am sure you are going to be nagged by the teletext community to add text and editing to this. Don’t blame me if they do! :lol:
Attachments
05CF0765-4645-44F0-8DC0-91A65E0691EC.png

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:34 am

Me putting *HEX 64 at the start stopped the program crashing when saving. It did it recently but since doing that it doesn’t it seems. I will let you know more through using it,

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 8:55 am

This is the cheer all the people up who hate Sundays (unless you are one of the people that actually enjoy them). I am going to blast you with colour to get it out of your system.
Attachments
FD1D254F-6EFC-4875-BA45-1444EC878BB1.jpeg

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 9:42 am

Lovely
Attachments
A93B7C57-EF33-4D2E-A890-F03185544CED.jpeg

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 9:44 am

I am split whether I should crop pics and get rid of the black bar at the side. I did it above. True teletext will show that bar...where the control codes go. It’s part of the charm of it.....

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

Re: Teletext paint program

Post by FourthStone » Sun Aug 23, 2020 11:46 am

Looks like the ink is flowing freely now =D>

I forgot to mention, with the solid char brush you have to select dither& '5', I'm trying to cram in everything to the existing tool bar as possible :wink:

I will check out the print, it might be a 64 bit number issues with iOS when display the ascii code for the F and B tools, will see if it can be limited to printing an 8 bit value.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 12:29 pm

I know it's annoying me firing more ideas all the time but I might as well whilst you still have the enthusiasm! Sooner or later it will run out and you will sit back and think ok I need to stop now and get my life back :lol:

I mentioned scrolling before . If you recall it was something I was playing around in another thread.

If would be fun to make the screen scroll..even if it's in simple character blocks. So you draw a page, then click SU SD SL or SR (on another menu) and it asks 'scroll screen up?' YES NO
Then it shifts the picture over 8 frames so when you play back the video finally it loops around. It could make a man walking down the street very easy to do. In some ways it's not unlike the colour cycling where we had just 8 frames to play with.

I am aware that when you scroll in Mode 7 it can muck up pictures due to control codes shifting so I think the rule would be one paints in mono when scrolling.

I think keeping it 8 frames is quite nice and it keeps it simple.....and the gifs quite small......

Anyway I know you are trying to get the other basics working at the moment.....

It is very featured now isn't it.....I think this is the nearest Deluxe Paint for Mode 7 we are going to get in our lifetime!

I might also down the line see how easy it might be to do what you did in Art4eva with animated dashed lines and dots....anyway the main thing at the moment is that animation is possible and easy to do so that is really great.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 2:34 pm

I’ll Carry on in acorn art thread with pics....
Attachments
087EF1C6-BE1E-4E0E-BB58-7D2EF82754C8.jpeg

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

Re: Teletext paint program

Post by Soruk » Sun Aug 23, 2020 4:10 pm

pixelblip wrote:
Sun Aug 23, 2020 8:19 am
There are times when painting background at the top introduces weirdness...just one line of it...sometimes the picture also scrolls up vertically if you are at the bottom painting background colours on the extreme left.
Richard will be able to confirm if VDU23,16 is supported in BBCSDL, but doing

Code: Select all

VDU23,16,1|
after the MODE 7 command should stop an automatic scroll when a character is placed in the bottom right character cell. And certainly after plotting a character in the bottom right cell, make sure there is no automatic CR/LF and ideally move the cursor away from that cell!
Matrix Brandy BASIC VI (work in progress)

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 4:57 pm

Thank you Soruk.....appreciated...

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 6:39 pm

Void 2
Attachments
Void2.png

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 6:42 pm

Can you spot the £=5 in the picture. That is an odd glitch. I didn't write it! That stays in. I love that kind of weirdness.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 6:58 pm

Sorry I said I was going to post in the art thread...apologies

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 7:43 pm

Hi Fourthstone....
Can I ask does the program save bmps when you click save? I wasn't sure or couldn't see them. I can see the raw files and the bin files.
I was going to do a little animated gif....
Thanks.
Another week of work eh...let Monday be over with as quickly as possible

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

Re: Teletext paint program

Post by FourthStone » Sun Aug 23, 2020 9:41 pm

Removed RAW format and added BMP saves, keep in mind that BMP's are almost 1mb each. The program will now use BIN format for loading and saving instead of RAW so you will see BIN + BMP files only.

Added a catch for 'B' and 'F' to limit the output to 8 bits, will see how it works on iOS. This should hopefully address the extra line print happening as it looks like a 16bit number was being printed.

Changed the codes for 'B' and 'F' to only use graphic colour codes instead of text, this should address random chars popping up.

Code: Select all

      MODE 7

      REM *** TODO LIST ***

      REM *** INKEY(-256) MATRIX BRANYDY &4D (INCLUDE OTHERS)

      REM *** INVESTIGATE LOCAL VERSIONS OF LIBRARIES TO MAKE PROGRAM CROSS BASIC COMPATIBLE

      REM *** SCROLLING, POSSIBLY ADD TO DUPLICATE DIALOG SO A SCENE CAN BE COPIED AND SCROLLED

      REM *** SECOND MENU (IN PROGRESS)

      REM *** TEMPLATE / DUPLICATE FRAME TO OTHER FRAMES (IN PROGRESS)

      REM *** COPY AND PASTE

      REM *** REDO, AND WHILE I'M AT IT ADD UNDOS & REDOS FOR EACH FRAME

      REM *** FLASHING COLOURS REQUESTED BUT MODE 7 ONLY HAS A FLASHING CODE, NOT CYCLED CLASHING COLOURS, NEED TO CLARIFY WHAT THIS FEATURE IS

      REM *** TODO LIST ***

      INSTALL @lib$+"sortlib"
      INSTALL @lib$+"stringlib"
      INSTALL @lib$+"dlglib"
      INSTALL @lib$+"filedlg"

      MOUSE ON 3

      REM drawing bounds used for < and >
      xMin%=1
      xMax%=80
      yMin%=2
      yMax%=75


      REM fill bounds & BUFFER used with < and >
      fxMin%=2
      fxMax%=80
      fyMin%=3
      fyMax%=74
      DIM fill{(100) x%,y%}

      REM UNDO TEST ARRAY
      UNDO_MAX%=19
      DIM UNDO_BUFFER(UNDO_MAX%,959)
      UNDO_INDEX%=0

      REM FRAME BUFFER ARRAY
      frame_max%=8
      DIM FRAME_BUFFER(frame_max%,959)

      REM OLD PIXEL & MOUSE COORDS
      OLD_PX%=0
      OLD_PY%=0
      OLD_MX%=0
      OLD_MY%=0
      OLD_TX%=0
      OLD_TY%=0

      REM MOUSE COORDS
      MX%=0
      MY%=0
      MB%=0

      REM TEXT & PIXEL COORDS FOR CURRENT MOUSE READ LOCATION
      TX%=0
      TY%=0
      PX%=0
      PY%=0

      REM TOOL VARS
      curcol%=7
      bakcol%=0
      toolsel%=1
      toolcursor%=15
      erase%=0
      dither%=0
      frame%=1
      animation%=0
      menuext%=0

      REM FILE DIALOG
      N%=0

      PROCGR(curcol%,bakcol%)
      PROCdrawmenu

      FOR frame%=1 TO frame_max%
        PROCframesave(frame%)
        REM WAIT 10
      NEXT frame%
      frame%=1


      REPEAT

        PROCREADMOUSE

        IF MX%<>OLD_MX% OR MY%<>OLD_MY% OR MB% THEN
          IF TY%=0 THEN
            REM CLICK INSIDE MENU AREA
            IF MB%=4 THEN
              CASE TX% OF
                WHEN 0:
                  IF menuext%=0 THEN
                    menuext%=1: PROCundosave
                  ELSE
                    menuext%=0: PROCundorestore
                  ENDIF
                WHEN 1: curcol%=1
                WHEN 3: curcol%=2
                WHEN 5: curcol%=3
                WHEN 7: curcol%=4
                WHEN 9: curcol%=5
                WHEN 11: curcol%=6
                WHEN 13: curcol%=7

                WHEN 15: toolsel%=1:toolcursor%=TX%: REM PAINT
                WHEN 16: toolsel%=2:toolcursor%=TX%: REM DITHER
                WHEN 17: dither%=(dither%+1) MOD 5: REM DITHER SCALE
                WHEN 18: PROCundorestore: REM UNDO

                WHEN 20: erase%=(erase%+1) AND 1: REM TOGLE ERASER

                WHEN 22: PROCclearscreen : REM CLEARSCREEN
                WHEN 23: toolsel%=5:toolcursor%=TX%: REM BACKGROUND COLOUR
                WHEN 24: toolsel%=6:toolcursor%=TX%: REM FORGROUND

                WHEN 26: toolsel%=7:toolcursor%=TX%: REM CIRCEL
                WHEN 27: toolsel%=8:toolcursor%=TX%: REM RECTANGLE
                WHEN 28: toolsel%=9:toolcursor%=TX%: REM LINE
                WHEN 29: toolsel%=10:toolcursor%=TX%: REM FILL

                WHEN 31: PROCloadfile: REM LOAD
                WHEN 32: PROCsavefile: REM SAVE

                WHEN 34: animation%=(animation%+1) AND 1: REM TOGLE ANIMATION FRAME ADVANCE TOOL

                WHEN 36: REM frame%
                WHEN 37: PROCloadnextframe(-1,1) : REM SAVE CURRENT FRAME AND LOAD PREVIOUS FRAME
                WHEN 38: PROCloadnextframe(1,1) : REM SAVE CURRENT FRAME AND LOAD NEXT FRAME
                WHEN 39: PROCplay : REM PLAY ALL FRAMES


              ENDCASE

              REM CHANGE BACKGROUND COLOUR, TEMPORARY CLUDGE
              REMIF TX%<14 THEN
              REMFOR Y%=1 TO 24
              REMPRINTTAB(0,Y%) CHR$(144+curcol%);
              REMNEXT
              REMENDIF

              PROCWAITMOUSE(0)

              PROCdrawmenu

            ENDIF

          ELSE
            REM CHECK IF EXTENDED MENU IS ACTIVE
            IF menuext% AND TY%=1 THEN
              IF MB%=4 THEN

                PROCWAITMOUSE(0)

                menuext%=0: PROCundorestore

              ENDIF

            ELSE

              IF toolsel%=5 OR toolsel%=6 THEN
                A$=STR$(GET(TX%,TY%) AND 255)
                IF LEN(A$)<3 THEN A$=STRING$(3-LEN(A$)," ")+A$
                VDU 23,1,0;0;0;0; : REM Disable cursor
                PRINTTAB(37,0)A$;
                VDU 23,1,1;0;0;0; : REM Enable cursor
              ENDIF

              REM CLICK INSIDE DRAWING AREA
              CASE MB% OF

                WHEN 1:
                  REM PLACE HOLDER FOR RIGHT MOUSE

                WHEN 2:
                  REM PLACE HOLDER FOR MIDDLE MOUSE

                WHEN 4:
                  REM LEFT MOUSE CLICK OR TOUCH SCREEN CLICK
                  IF menuext%=1 THEN menuext%=0: PROCundorestore

                  CASE toolsel% OF
                    WHEN 1: REM PAINT TOOL
                      PROCundosave
                      PROCpoint(PX%,PY%,1)
                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN PROCpoint(PX%,PY%,1-erase%)
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 2: REM DITHER TOOL
                      PROCundosave
                      D%=2^(dither%)
                      DA%=2
                      IF dither%=2 THEN DA%=4
                      IF dither%=3 THEN DA%=8

                      X%=(PX% DIV DA%)*DA%
                      Y%=(PY% DIV DA%)*DA%
                      IF dither%<4 THEN
                        PROCpoint(X%,Y%,1-erase%)
                        PROCpoint(X%+D%,Y%+D%,1-erase%)
                      ELSE
                        IF TX%>0 THEN VDU 31,TX%,TY%,255+(erase%=1)*95
                      ENDIF
                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          IF dither%<4 THEN
                            X%=(PX% DIV DA%)*DA%
                            Y%=(PY% DIV DA%)*DA%
                            PROCpoint(X%,Y%,1-erase%)
                            PROCpoint(X%+D%,Y%+D%,1-erase%)
                          ELSE
                            IF TX%>0 THEN VDU 31,TX%,TY%,255+(erase%=1)*95
                          ENDIF
                        ENDIF
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 5: REM BACKGROUND COLOUR
                      PROCundosave
                      VDU 31,TX%,TY%,(curcol%+144),157-erase%
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN VDU 31,TX%,TY%,(curcol%+144),157-erase%
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0

                    WHEN 6: REM FORGROUND COLOUR
                      PROCundosave
                      VDU 31,TX%,TY%,(curcol%+144)
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN VDU 31,TX%,TY%,(curcol%+144)
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0

                    WHEN 7: REM CIRCLE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      REM PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCcircle(startx%,starty%,startx%-OLD_PX%,2)
                          PROCcircle(startx%,starty%,startx%-PX%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0
                      PROCcircle(startx%,starty%,startx%-PX%,1-erase%)
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 8: REM RECTANGLE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCrectangle(startx%,starty%,OLD_PX%,OLD_PY%,2)
                          PROCrectangle(startx%,starty%,PX%,PY%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0
                      PROCrectangle(startx%,starty%,PX%,PY%,1-erase%)
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 9: REM LINE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCbresenham(startx%,starty%,OLD_PX%,OLD_PY%,2)
                          PROCbresenham(startx%,starty%,PX%,PY%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0
                      PROCbresenham(startx%,starty%,PX%,PY%,1-erase%)
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 10: REM FILL TOOL
                      PROCundosave
                      PROCfloodfill(PX%,PY%)
                      REPEAT
                        PROCREADMOUSE
                        WAIT 2
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                  ENDCASE


              ENDCASE

            ENDIF
          ENDIF

        ELSE
          WAIT 2
        ENDIF

        REM SHOW ALL MOUSE TRACKING DETAILS
        REM PRINTTAB(0,0)SPC(40)
        REM PRINTTAB(0,0)"MX:";STR$(MX%);" MY:";STR$(MY%);" TX:";STR$(TX%);" TY:";STR$(TY%);" PX:";STR$(PX%);" PY:";STR$(PY%)


        REM REMEMBER MOUSE POSITION
        OLD_MX%=MX%
        OLD_MY%=MY%

      UNTIL 0

      END

      REM READ MOUSE AND CALCULATE TEXT AND SIXEL LOCATIONS
      DEF PROCREADMOUSE

      MOUSE MX%,MY%,MB%

      REM TEXT LOCATION RELEATIVE TO MOUSE
      TX%=MX% DIV 32
      TY%=(999-MY%) DIV 40

      REM SIXEL LOCATION RELEATIVE TO MOUSE
      PX%=MX% DIV 16
      PY%=(999-MY%)/13.3333333

      IF toolsel%=5 OR toolsel%=6 THEN
        VDU 31,TX%,TY%
      ELSE
        VDU 31,toolcursor%,0
      ENDIF


      ENDPROC

      REM WAIT FOR MOUSE TO BE A SPECIFIC BUTTON CLICK
      DEF PROCWAITMOUSE(M%)
      REPEAT
        PROCREADMOUSE
        WAIT 2
      UNTIL MB%=M%
      ENDPROC


      REM Read the point at the specified coordinates (1=set, 0=cleared)
      DEFFNpoint(x%,y%)
      LOCAL cx%,cy%,chr%,C%
      REM Get character cell
      cx% = x% DIV 2
      cy% = y% DIV 3
      chr%=GET(cx%,cy%) AND &5F
      C%=(x% AND 1)+(y% MOD 3)*2
      C%=2^C% - (C%=5)*32
      =SGN(chr% AND C%)

      REM Plot a Teletext sixel point
      REM SIXEL COORDINATES WITH 0,0 BEING TOP LEFT THE SAME AS THE TEXT SCREEN
      REM cmd% 0: Clear the point
      REM cmd% 1: Set the point
      REM cmd% 2: Toggle the point
      DEFPROCpoint(x%, y%, cmd%)

      IF x%>xMin% AND x%<xMax% AND y%>yMin% AND y%<yMax% THEN

        LOCAL cx%,cy%,chr%,C%
        REM Get character cell
        cx% = x% DIV 2
        cy% = y% DIV 3
        chr%=GET(cx%,cy%) AND &5F
        C%=(x% AND 1)+(y% MOD 3)*2
        C%=2^C% - (C%=5)*32
        CASE cmd% OF
          WHEN 0:chr% AND=(&5F - C%)
          WHEN 1:chr% OR=C%
          WHEN 2:chr% EOR=C%
        ENDCASE

        VDU 31,cx%, cy%,(chr%+160)
      ENDIF

      ENDPROC

      REM LINE ROUTINE USE m% TO PERFORM 0=ERASE / 1=DRAW / 2=EOR
      DEF PROCbresenham(x1%,y1%,x2%,y2%,m%)
      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
        PROCpoint(x1%,y1%,m%)
        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

      REM RECTANGLE ROUTINE
      DEF PROCrectangle(x1%,y1%,x2%,y2%,m%)

      REM CHECK FOR SPECIAL CASES TO PRESERVE EOR OPERATIONS
      IF x1%=x2% AND y1%=y2% THEN
        PROCpoint(x1%,y1%,m%)
      ELSE
        IF x1%=x2% OR y1%=y2% THEN
          PROCbresenham(x1%,y1%,x2%,y2%,m%)
        ELSE
          PROCbresenham(x1%,y1%,x2%,y1%,m%)
          PROCbresenham(x1%,y2%,x2%,y2%,m%)
          IF ABS(y2%-y1%)>1 THEN
            IF y1%>y2% THEN SWAP y1%,y2%
            FOR Y%=y1%+1 TO y2%-1
              PROCpoint(x1%,Y%,m%)
              PROCpoint(x2%,Y%,m%)
            NEXT
          ENDIF
        ENDIF
      ENDIF
      ENDPROC

      REM CIRCLE ROUTINE
      DEF PROCcircle(x1%,y1%,r%,m%)
      LOCAL p,x%,y%

      r%=ABS(r%)
      p=(5-r%*4)/4
      x%=0
      y%=r%

      PROCcirclepoints(x1%,y1%,x%,y%,m%)

      WHILE x%<y%
        x%+=1
        IF p<0 THEN
          p+=2*x%+1
        ELSE
          y%-=1
          p+=2*(x%-y%)+1
        ENDIF
        PROCcirclepoints(x1%,y1%,x%,y%,m%)
      ENDWHILE

      ENDPROC

      REM THIS PLOTS THE POINTS FOR CIRCLE ROUTINE
      DEF PROCcirclepoints(cx%,cy%,x%,y%,m%)
      IF x%=0 THEN
        PROCpoint(cx%,cy%+y%,m%)
        PROCpoint(cx%,cy%-y%,m%)
        PROCpoint(cx%+y%,cy%,m%)
        PROCpoint(cx%-y%,cy%,m%)
      ELSE
        IF x%<=y% THEN
          PROCpoint(cx%+x%,cy%+y%,m%)
          PROCpoint(cx%-x%,cy%+y%,m%)
          PROCpoint(cx%+x%,cy%-y%,m%)
          PROCpoint(cx%-x%,cy%-y%,m%)
          IF x%<y% THEN
            PROCpoint(cx%+y%,cy%+x%,m%)
            PROCpoint(cx%-y%,cy%+x%,m%)
            PROCpoint(cx%+y%,cy%-x%,m%)
            PROCpoint(cx%-y%,cy%-x%,m%)
          ENDIF
        ENDIF
      ENDIF
      ENDPROC

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

      IF sx%>xMin% AND sx%<xMax% AND sy%>yMin% AND sy%<yMax% 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 FNpoint(x%,y%) = 0 THEN

            uf=1 : df=1

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

            REM scan right
            WHILE x%<fxMax% AND FNpoint(x%,y%) = 0
              PROCpoint(x%,y%,1)

              REM detect colour changes above and add to list
              IF y%<fyMax% THEN
                c%=FNpoint(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%=FNpoint(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

      REM UPDATE CLEARSCREEN OPTIONS
      DEF PROCupdateCS
      PRINTTAB(5,9)"FORE  ";CHR$(234);SPC(17);CHR$(181);
      PRINTTAB(5,11)"BACK  ";CHR$(234);SPC(17);CHR$(181);

      IF bakcol%=0 THEN PRINTTAB(13,11)"B"

      FOR I%=1 TO 7
        PRINTTAB(12+I%*2,9)CHR$(144+I%);CHR$(255+(I%=curcol%)*185);
        PRINTTAB(12+I%*2,11)CHR$(144+I%);CHR$(255+(I%=bakcol%)*189);
      NEXT

      PRINTTAB(5,13)"OUTPUT";
      IF bakcol%>0 THEN
        VDU 144+bakcol%,157,144+curcol%
      ELSE
        VDU 32,32,144+curcol%
      ENDIF
      PRINTTAB(14,13)"abcdefghijklmno";CHR$(156);CHR$(151)

      ENDPROC

      REM CLEARSCREEN DIALOG
      DEF PROCclearscreen
      PROCundosave
      PROCWAITMOUSE(0)

      FOR L%=6 TO 18
        PRINTTAB(0,L%)SPC(40);
      NEXT

      PRINTTAB(2,6)CHR$(151);CHR$(232);STRING$(9,CHR$(172));CHR$(130);"CLEARSCREEN";CHR$(151);STRING$(9,CHR$(172));CHR$(180);
      FOR L%=7 TO 17
        PRINTTAB(2,L%)CHR$(151);CHR$(234);STRING$(30," ");CHR$(151);CHR$(181);
      NEXT

      PRINTTAB(5,15)CHR$(129);"MORE OPTIONS COMING!";
      PRINTTAB(5,17)CHR$(146);CHR$(157);CHR$(132);"ALL FRAMES  ";CHR$(156);" ";CHR$(145);CHR$(157);CHR$(131);"CANCEL  ";CHR$(156);
      PRINTTAB(2,18)CHR$(151);CHR$(170);STRING$(31,CHR$(172));CHR$(165);

      PROCupdateCS

      done%=0
      col_old%=curcol%
      bak_old%=bakcol%
      REPEAT
        PROCREADMOUSE
        IF MB%=4 THEN
          REPEAT
            PROCREADMOUSE
            IF TY%=9 THEN
              IF TX%>13 AND TX%<28 THEN curcol%=(TX%-12) DIV 2
            ENDIF
            IF TY%=11 THEN
              IF TX%>11 AND TX%<28 THEN bakcol%=(TX%-12) DIV 2
            ENDIF

            IF TY%=17 THEN
              IF TX%>5 AND TX%<20 THEN done%=1
              IF TX%>23 AND TX%<33 THEN done%=-1
            ENDIF

          UNTIL MB%=0
          IF col_old%<>curcol% OR bak_old%<>bakcol% THEN
            PROCupdateCS
            col_old%=curcol%
            bak_old%=bakcol%

          ENDIF
        ENDIF
      UNTIL done%

      PROCWAITMOUSE(0)

      IF done%=1 THEN
        PROCGR(curcol%,bakcol%)

        FOR frame%=1 TO frame_max%
          PROCframesave(frame%)
          REM WAIT 10
        NEXT frame%
        frame%=1

        REMPROCloadnextframe(1,0)
      ELSE
        PROCundorestore
      ENDIF
      ENDPROC

      REM SAVE FRAME BUFFER
      DEF PROCframesave(f%)
      LOCAL U%

      FOR U%=0 TO 959
        FRAME_BUFFER(f%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM RESTORE FRAME BUFFER
      DEF PROCframerestore(f%)
      LOCAL U%

      FOR U%=0 TO 959
        VDU 31,(U% MOD 40),(U% DIV 40+1),FRAME_BUFFER(f%,U%)
      NEXT

      ENDPROC

      DEF PROCloadnextframe(F%,S%)

      IF S% THEN
        PROCWAITMOUSE(0)
        PROCframesave(frame%)
      ENDIF
      frame%+=F%
      IF frame%>frame_max% THEN frame%=1
      IF frame%<1 THEN frame%=frame_max%
      PROCframerestore(frame%)
      PROCdrawmenu
      ENDPROC

      REM SAVE UNDO SCREEN
      DEF PROCundosave
      LOCAL U%
      UNDO_INDEX%+=1
      IF UNDO_INDEX%>UNDO_MAX% THEN UNDO_INDEX%=0

      FOR U%=0 TO 959
        UNDO_BUFFER(UNDO_INDEX%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM SAVE UNDO SCREEN
      DEF PROCundorestore
      LOCAL U%

      FOR U%=0 TO 959
        VDU 31,(U% MOD 40),(U% DIV 40+1),UNDO_BUFFER(UNDO_INDEX%,U%)
      NEXT

      UNDO_INDEX%-=1
      IF UNDO_INDEX%<0 THEN UNDO_INDEX%=UNDO_MAX%

      ENDPROC

      REM SAVE BINARY FILE
      DEF PROCsavebinaryfile(F$)
      f%=OPENOUT(F$)
      FOR U%=0 TO 999
        BPUT#f%,GET(U% MOD 40,U% DIV 40)
      NEXT
      CLOSE#f%
      ENDPROC

      REM LOAD BINARY FILE
      DEF PROCloadbinaryfile(F$)
      f%=OPENIN(F$)

      FOR U%=0 TO 999
        char%=BGET#f%
        VDU 31,U% MOD 40,U% DIV 40,char%
      NEXT
      CLOSE#f%
      ENDPROC


      REM LOADFILE
      DEF PROCloadfile

      LOCAL N%
      DIM n$(10000)

      N% = FN_dirscan(n$(), "dir *.*", "", "", "")


      PROCWAITMOUSE(0)
      PROCundosave
      FOR L%=6 TO 18
        PRINTTAB(0,L%)SPC(40);
      NEXT


      PRINTTAB(2,6)CHR$(151);CHR$(232);STRING$(10,CHR$(172));CHR$(130);"LOAD FILE";CHR$(151);STRING$(10,CHR$(172));CHR$(180);
      FOR L%=7 TO 17
        PRINTTAB(2,L%)CHR$(151);CHR$(234);STRING$(30," ");CHR$(151);CHR$(181);
      NEXT
      PRINTTAB(2,18)CHR$(151);CHR$(170);STRING$(31,CHR$(172));CHR$(165);

      F%=0
      S%=0
      SEL%=0
      SELOLD%=0
      SELY%=-1
      INDEX%=1
      INDEXOLD%=1
      DC%=0


      FOR I%=INDEX% TO INDEX%+10
        IF I%<N% THEN PRINTTAB(6,6+I%)CHR$(131);LEFT$(n$(I%),24);
      NEXT

      REPEAT
        PROCREADMOUSE

        IF MB%=4 THEN
          IF MY%<>OLD_MY% THEN INDEX%+=SGN(MY%-OLD_MY%)
          IF INDEX%<1 THEN INDEX%=1
          IF INDEX%>N%-10 THEN INDEX%=N%-10
          IF SELY%=-1 THEN SELY%=MY%

        ENDIF

        IF MB%=0 THEN
          IF SELY%=MY% THEN
            S%=TY%-7
            IF S%>-1 AND S%<11 THEN SEL%=S%+INDEX%
            IF SEL%<1 THEN SEL%=1
            IF SEL%>N% THEN SEL%=N%
            F%=SEL%
            IF TX%<6 OR TX%>32 OR TY%<7 OR TY%>17 THEN F%=-1
          ENDIF
          SELY%=-1
        ENDIF

        IF INDEX%<>INDEXOLD% OR SELOLD%<>SEL% THEN
          FOR I%=0 TO 10
            K%=I%+INDEX%
            PRINTTAB(4,I%+7)SPC(30);
            IF K%<N%+1 THEN
              VDU 31,4,I%+7
              IF SEL%=K% THEN
                VDU 132,157
              ELSE
                VDU 32,32
              ENDIF
              PRINTCHR$(131);LEFT$(n$(K%),24);
              IF SEL%=K% THEN VDU 32,32,156
            ENDIF
          NEXT
          SELOLD%=SEL%
          INDEXOLD%=INDEX%
        ENDIF

        REM PRINTTAB(0,1)STR$(SEL%)

        OLD_MY%=MY%


        WAIT 2
      UNTIL F%<>0

      PROCundorestore

      IF F%>0 THEN
        IF LEFT$(n$(SEL%),3)="M7_" THEN
          F$=LEFT$(n$(SEL%),22)
          FOR frame%=1 TO frame_max%
            REM PROCloadsave7("load """ + F$ + STR$(frame%)+".RAW"" " + STR$~@chrmap% + " +3200")
            PROCloadbinaryfile(F$ + STR$(frame%)+".BIN")
            PROCframesave(frame%)
            REM WAIT 10
          NEXT
          PROCloadnextframe(1,0)
        ELSE

        ENDIF
      ENDIF
      ENDPROC

      REM SAVEFILE
      DEF PROCsavefile
      PROCWAITMOUSE(0)

      PROCframesave(frame%)

      REM SAVE FRAMES
      T$=TIME$
      C%=FN_findreplace(T$, ".", "", 1)
      C%=FN_findreplace(T$, " ", "", 1)
      C%=FN_findreplace(T$, ",", "", 1)
      C%=FN_findreplace(T$, ":", "", 1)

      frame%=frame_max%
      FOR I%=1 TO frame_max%
        PROCloadnextframe(1,0)
        PROCsavebinaryfile("M7_" + T$ + "_" + STR$(frame%)+".BIN")
        REM PROCloadsave7("save ""M7_" + T$ + "_" + STR$(frame%)+".RAW"" " + STR$~@chrmap% + " +3200")
        OSCLI "SCREENSAVE ""M7_" + T$ + "_" + STR$(frame%)+".BMP"" 0,0,1279,999"
        WAIT 10
      NEXT

      PROCloadnextframe(1,0)

      PROCundosave
      PRINTTAB(9,10)CHR$(151);CHR$(232);STRING$(18,CHR$(172));CHR$(180);CHR$(144+curcol%);
      FOR L%=11 TO 13
        PRINTTAB(9,L%)CHR$(151);CHR$(234);STRING$(17," ");CHR$(151);CHR$(181);CHR$(144+curcol%);
      NEXT
      PRINTTAB(9,14)CHR$(151);CHR$(170);STRING$(18,CHR$(172));CHR$(165);CHR$(144+curcol%);

      REM READ FILES
      PRINTTAB(13,12)CHR$(130);"FILE SAVED!";

      PROCWAITMOUSE(4)

      PROCWAITMOUSE(0)

      PROCundorestore

      ENDPROC

      DEF PROCloadsave7(F$)
      *HEX 64
      OSCLI F$

      REM REFRESH THE SCREEN FOR *LOAD
      IF LEFT$(F$,4)="load" THEN VDU 23,18,3|

      ENDPROC

      DEF PROCplay
      PROCWAITMOUSE(0)

      D%=0

      frame%=frame_max%
      REPEAT
        PROCloadnextframe(1,0)
        FOR I%=0 TO 9
          PROCREADMOUSE
          IF MB%<>0 THEN D%=1
          WAIT 2
        NEXT
      UNTIL D%
      PROCWAITMOUSE(0)
      ENDPROC

      REM INITIALISE THE SCREEN
      DEF PROCGR(F%,B%)

      REM CLS
      VDU 12

      REM ADD GRAPHICS CODE TO LEFT SIDE OF CANVAS
      FOR Y%=1 TO 24
        VDU 31,0,Y%
        IF B% THEN VDU 128+B%,157
        VDU 144+F%
      NEXT

      ENDPROC

      REM PRINT PALETTE AND MENU
      DEF PROCdrawmenu
      FOR count%=1 TO 7
        PRINTTAB(count%*2-2,0) CHR$(128+count%);CHR$(255+(count%=curcol%)*213);
      NEXT count%
      PRINTTAB(14,0) CHR$(135);"PD";STR$(dither%+1);"U";CHR$(135-erase%*5);"E";CHR$(135);"CBF ORLF LS";CHR$(135-animation%*5);"A";CHR$(135);STR$(frame%);"<>P"
      IF menuext% THEN PRINTTAB(0,1)CHR$(130);"----- This is the extended menu! -----"
      ENDPROC

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 10:03 pm

Well done thanks Fourthstone. Especially on a Monday morning!
It would be very handy (Richard) if bbc basic could save as .png but I expect you would have done this if you could have. I can start doing some animations soon...simple things.
If the bin files are there I can always load some sprites myself over the top in bbc basic after....it will be interesting to see what comes out.
Well have a good week everyone see you on the other side. Enjoy Monday being over with Fourthstone !

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 10:09 pm

Ps thanks for sorting that background colour thing out.
You must have done that very early in the morning before getting out of bed as it’s 7am over there now as I type this!

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

Re: Teletext paint program

Post by FourthStone » Sun Aug 23, 2020 10:21 pm

pixelblip wrote:
Sun Aug 23, 2020 10:09 pm
Ps thanks for sorting that background colour thing out.
You must have done that very early in the morning before getting out of bed as it’s 7am over there now as I type this!
I did it in a dream and when I got up just now it was magically fixed :lol:

Usually up @ 5-5:30 most days, early bird an all, it's usually when my best coding happens as the rest of the household is still asleep =D>

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 23, 2020 10:26 pm

Well that is something, I can’t talk for an hour at least. Just glug a pot of strong coffee and try to cheer myself up which fails...so hats of to you!! A positive attitude you have!

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

Re: Teletext paint program

Post by pixelblip » Mon Aug 24, 2020 9:37 pm

Morming. I saw in your program comments on to do list...Flashing colours requested....
What I meant there was a facility to draw a dotted line or circle or rectangle that can be animated.
So you draw the lines...circles.....click calculate and it draws 8 frames of animation with those shapes that move .
Really that's just like art4eva in a way and colour cycling. That also produces 8 frames.
It would be nice to vary the dash size as well.....also very interesting to combine with a scroll feature.

It's getting hard now....I do ask alot! Thanks for considering it.
I think more important is to try to get a copy frame thing in as having a background picture you can animate over is very useful. Thanks.
Last edited by pixelblip on Mon Aug 24, 2020 9:39 pm, edited 1 time in total.

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

Re: Teletext paint program

Post by FourthStone » Tue Aug 25, 2020 6:17 am

Another update to add duplicate frame and animate line.

* Duplicate Frame works by taking the current frame and duplicating it to all 8 frames, it is access in the clear screen dialog and is a separate action to clear frame, so you pick one or the other actions.

* Animate line works by selecting the Line tool in the main menu and activating animate line in the second menu, it is rather slow as I am updating each frame in sequence but if it looks like it is doing what you want I should be able to speed it up by updating just the buffers. I haven't added gaps and dash length yet, I want you to test and let me know if it's what you want.

Question about how tools currently work, they overwrite any control codes with the graphics codes, so for instance if you do a Clear Screen and choose and background and foreground colour, it is east to corrupt the scene if drawing in the first 3 columns. I could tell the line drawing routines to ignore foreground and background colour codes if you think it's needed... maybe it could be a toggle option in a menu.

Another observation, I managed to load up BBCSDL on my android phone and I get the file error, so I can now start to trouble shoot that.
M7.png

Code: Select all

      MODE 7

      REM *** TODO LIST ***

      REM *** INKEY(-256) MATRIX BRANYDY &4D (INCLUDE OTHERS)

      REM *** INVESTIGATE LOCAL VERSIONS OF LIBRARIES TO MAKE PROGRAM CROSS BASIC COMPATIBLE

      REM *** SCROLLING, POSSIBLY ADD TO DUPLICATE DIALOG SO A SCENE CAN BE COPIED AND SCROLLED

      REM *** SECOND MENU (IN PROGRESS)

      REM *** TEMPLATE / DUPLICATE FRAME TO OTHER FRAMES (IN PROGRESS)

      REM *** COPY AND PASTE

      REM *** REDO, AND WHILE I'M AT IT ADD UNDOS & REDOS FOR EACH FRAME

      REM *** FLASHING COLOURS REQUESTED BUT MODE 7 ONLY HAS A FLASHING CODE, NOT CYCLED CLASHING COLOURS, NEED TO CLARIFY WHAT THIS FEATURE IS

      REM *** TODO LIST ***

      INSTALL @lib$+"sortlib"
      INSTALL @lib$+"stringlib"
      INSTALL @lib$+"dlglib"
      INSTALL @lib$+"filedlg"

      REM FOR 64 BIT COMPARISONS, ESC OFF FOR BACK ARROW ON SOME DEVICES
      *HEX 64
      *ESC OFF

      MOUSE ON 3

      REM drawing bounds used for < and >
      xMin%=1
      xMax%=80
      yMin%=2
      yMax%=75


      REM fill bounds & BUFFER used with < and >
      fxMin%=2
      fxMax%=80
      fyMin%=3
      fyMax%=74
      DIM fill{(100) x%,y%}

      REM UNDO TEST ARRAY
      UNDO_MAX%=19
      DIM UNDO_BUFFER(UNDO_MAX%,959)
      UNDO_INDEX%=0

      REM FRAME BUFFER ARRAY
      frame_max%=8
      DIM FRAME_BUFFER(frame_max%,959)

      REM OLD PIXEL & MOUSE COORDS
      OLD_PX%=0
      OLD_PY%=0
      OLD_MX%=0
      OLD_MY%=0
      OLD_TX%=0
      OLD_TY%=0

      REM MOUSE COORDS
      MX%=0
      MY%=0
      MB%=0

      REM TEXT & PIXEL COORDS FOR CURRENT MOUSE READ LOCATION
      TX%=0
      TY%=0
      PX%=0
      PY%=0

      REM TOOL VARS
      curcol%=7
      bakcol%=0
      toolsel%=1
      toolcursor%=15
      animateline%=0
      erase%=0
      dither%=0
      frame%=1
      animation%=0
      menuext%=0

      REM FILE DIALOG
      N%=0

      PROCGR(curcol%,bakcol%)
      PROCdrawmenu

      FOR frame%=1 TO frame_max%
        PROCframesave(frame%)
        REM WAIT 10
      NEXT frame%
      frame%=1


      REPEAT

        PROCREADMOUSE

        IF MX%<>OLD_MX% OR MY%<>OLD_MY% OR MB% THEN
          IF TY%=0 THEN
            REM CLICK INSIDE MENU AREA
            IF MB%=4 THEN
              CASE TX% OF
                WHEN 0:
                  IF menuext%=0 THEN
                    menuext%=1: PROCundosave
                  ELSE
                    menuext%=0: PROCundorestore
                  ENDIF
                WHEN 1: curcol%=1
                WHEN 3: curcol%=2
                WHEN 5: curcol%=3
                WHEN 7: curcol%=4
                WHEN 9: curcol%=5
                WHEN 11: curcol%=6
                WHEN 13: curcol%=7

                WHEN 15: toolsel%=1:toolcursor%=TX%: REM PAINT
                WHEN 16: toolsel%=2:toolcursor%=TX%: REM DITHER
                WHEN 17: dither%=(dither%+1) MOD 5: REM DITHER SCALE
                WHEN 18: PROCundorestore: REM UNDO

                WHEN 20: erase%=(erase%+1) AND 1: REM TOGLE ERASER

                WHEN 22: PROCclearscreen : REM CLEARSCREEN
                WHEN 23: toolsel%=5:toolcursor%=TX%: REM BACKGROUND COLOUR
                WHEN 24: toolsel%=6:toolcursor%=TX%: REM FORGROUND

                WHEN 26: toolsel%=7:toolcursor%=TX%: REM CIRCEL
                WHEN 27: toolsel%=8:toolcursor%=TX%: REM RECTANGLE
                WHEN 28: toolsel%=9:toolcursor%=TX%: REM LINE
                WHEN 29: toolsel%=10:toolcursor%=TX%: REM FILL

                WHEN 31: PROCloadfile: REM LOAD
                WHEN 32: PROCsavefile: REM SAVE

                WHEN 34: animation%=(animation%+1) AND 1: REM TOGLE ANIMATION FRAME ADVANCE TOOL

                WHEN 36: REM frame%
                WHEN 37: PROCloadnextframe(-1,1) : REM SAVE CURRENT FRAME AND LOAD PREVIOUS FRAME
                WHEN 38: PROCloadnextframe(1,1) : REM SAVE CURRENT FRAME AND LOAD NEXT FRAME
                WHEN 39: PROCframesave(frame%): PROCplay : REM SAVE CURRENT FRAME AND PLAY ALL FRAMES FROM FRAME 1


              ENDCASE

              REM CHANGE BACKGROUND COLOUR, TEMPORARY CLUDGE
              REMIF TX%<14 THEN
              REMFOR Y%=1 TO 24
              REMPRINTTAB(0,Y%) CHR$(144+curcol%);
              REMNEXT
              REMENDIF

              PROCWAITMOUSE(0)

              PROCdrawmenu

            ENDIF

          ELSE
            REM CHECK IF EXTENDED MENU IS ACTIVE
            IF menuext% AND TY%=1 THEN
              IF MB%=4 THEN
                CASE TX% OF
                  WHEN 18: animateline%=(animateline%+1) AND 1 : REM ANIMATED LINE TOGGLE
                  WHEN 20: : REM ANIMATED CIRCLE
                  WHEN 22: : REM ANIMATED BOX
                ENDCASE
                PROCWAITMOUSE(0)

                menuext%=0: PROCundorestore

              ENDIF

            ELSE

              IF toolsel%=5 OR toolsel%=6 THEN
                A$=STR$(GET(TX%,TY%) AND 255)
                IF LEN(A$)<3 THEN A$=STRING$(3-LEN(A$)," ")+A$
                VDU 23,1,0;0;0;0; : REM Disable cursor
                PRINTTAB(37,0)A$;
                VDU 23,1,1;0;0;0; : REM Enable cursor
              ENDIF

              REM CLICK INSIDE DRAWING AREA
              CASE MB% OF

                WHEN 1:
                  REM PLACE HOLDER FOR RIGHT MOUSE

                WHEN 2:
                  REM PLACE HOLDER FOR MIDDLE MOUSE

                WHEN 4:
                  REM LEFT MOUSE CLICK OR TOUCH SCREEN CLICK
                  IF menuext%=1 THEN menuext%=0: PROCundorestore

                  CASE toolsel% OF
                    WHEN 1: REM PAINT TOOL
                      PROCundosave
                      PROCpoint(PX%,PY%,1)
                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN PROCpoint(PX%,PY%,1-erase%)
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 2: REM DITHER TOOL
                      PROCundosave
                      D%=2^(dither%)
                      DA%=2
                      IF dither%=2 THEN DA%=4
                      IF dither%=3 THEN DA%=8

                      X%=(PX% DIV DA%)*DA%
                      Y%=(PY% DIV DA%)*DA%
                      IF dither%<4 THEN
                        PROCpoint(X%,Y%,1-erase%)
                        PROCpoint(X%+D%,Y%+D%,1-erase%)
                      ELSE
                        IF TX%>0 THEN VDU 31,TX%,TY%,255+(erase%=1)*95
                      ENDIF
                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          IF dither%<4 THEN
                            X%=(PX% DIV DA%)*DA%
                            Y%=(PY% DIV DA%)*DA%
                            PROCpoint(X%,Y%,1-erase%)
                            PROCpoint(X%+D%,Y%+D%,1-erase%)
                          ELSE
                            IF TX%>0 THEN VDU 31,TX%,TY%,255+(erase%=1)*95
                          ENDIF
                        ENDIF
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 5: REM BACKGROUND COLOUR
                      PROCundosave
                      VDU 31,TX%,TY%,(curcol%+144),157-erase%
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN VDU 31,TX%,TY%,(curcol%+144),157-erase%
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0

                    WHEN 6: REM FORGROUND COLOUR
                      PROCundosave
                      VDU 31,TX%,TY%,(curcol%+144)
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN VDU 31,TX%,TY%,(curcol%+144)
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0

                    WHEN 7: REM CIRCLE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      REM PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCcircle(startx%,starty%,startx%-OLD_PX%,2)
                          PROCcircle(startx%,starty%,startx%-PX%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0
                      PROCcircle(startx%,starty%,startx%-PX%,1-erase%)
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 8: REM RECTANGLE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCrectangle(startx%,starty%,OLD_PX%,OLD_PY%,2)
                          PROCrectangle(startx%,starty%,PX%,PY%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0
                      PROCrectangle(startx%,starty%,PX%,PY%,1-erase%)
                      IF animation% THEN PROCloadnextframe(1,1)

                    WHEN 9: REM LINE TOOL
                      PROCundosave
                      startx%=PX%: starty%=PY%
                      OLD_PX%=PX% : OLD_PY%=PY%
                      PROCpoint(startx%,starty%,2)

                      REPEAT
                        PROCREADMOUSE
                        IF PX%<>OLD_PX% OR PY%<>OLD_PY% THEN
                          PROCbresenham(startx%,starty%,OLD_PX%,OLD_PY%,2)
                          PROCbresenham(startx%,starty%,PX%,PY%,2)
                          OLD_PX%=PX%
                          OLD_PY%=PY%
                        ENDIF
                      UNTIL MB%=0

                      IF animateline% THEN
                        PROCbresenham(startx%,starty%,PX%,PY%,2)
                        PROCbresenham2(startx%,starty%,PX%,PY%,1-erase%)
                      ELSE
                        PROCbresenham(startx%,starty%,PX%,PY%,1-erase%)
                        IF animation% THEN PROCloadnextframe(1,1)
                      ENDIF

                    WHEN 10: REM FILL TOOL
                      PROCundosave
                      PROCfloodfill(PX%,PY%)
                      REPEAT
                        PROCREADMOUSE
                        WAIT 2
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

                  ENDCASE


              ENDCASE

            ENDIF
          ENDIF

        ELSE
          WAIT 2
        ENDIF

        REM SHOW ALL MOUSE TRACKING DETAILS
        REM PRINTTAB(0,0)SPC(40)
        REM PRINTTAB(0,0)"MX:";STR$(MX%);" MY:";STR$(MY%);" TX:";STR$(TX%);" TY:";STR$(TY%);" PX:";STR$(PX%);" PY:";STR$(PY%)


        REM REMEMBER MOUSE POSITION
        OLD_MX%=MX%
        OLD_MY%=MY%

      UNTIL 0

      END

      REM READ MOUSE AND CALCULATE TEXT AND SIXEL LOCATIONS
      DEF PROCREADMOUSE

      MOUSE MX%,MY%,MB%

      REM TEXT LOCATION RELEATIVE TO MOUSE
      TX%=MX% DIV 32
      TY%=(999-MY%) DIV 40

      REM SIXEL LOCATION RELEATIVE TO MOUSE
      PX%=MX% DIV 16
      PY%=(999-MY%)/13.3333333

      IF toolsel%=5 OR toolsel%=6 THEN
        VDU 31,TX%,TY%
      ELSE
        VDU 31,toolcursor%,0
      ENDIF


      ENDPROC

      REM WAIT FOR MOUSE TO BE A SPECIFIC BUTTON CLICK
      DEF PROCWAITMOUSE(M%)
      REPEAT
        PROCREADMOUSE
        WAIT 2
      UNTIL MB%=M%
      ENDPROC


      REM Read the point at the specified coordinates (1=set, 0=cleared)
      DEFFNpoint(x%,y%)
      LOCAL cx%,cy%,chr%,C%
      REM Get character cell
      cx% = x% DIV 2
      cy% = y% DIV 3
      chr%=GET(cx%,cy%) AND &5F
      C%=(x% AND 1)+(y% MOD 3)*2
      C%=2^C% - (C%=5)*32
      =SGN(chr% AND C%)

      REM Plot a Teletext sixel point
      REM SIXEL COORDINATES WITH 0,0 BEING TOP LEFT THE SAME AS THE TEXT SCREEN
      REM cmd% 0: Clear the point
      REM cmd% 1: Set the point
      REM cmd% 2: Toggle the point
      DEFPROCpoint(x%, y%, cmd%)

      IF x%>xMin% AND x%<xMax% AND y%>yMin% AND y%<yMax% THEN

        LOCAL cx%,cy%,chr%,C%
        REM Get character cell
        cx% = x% DIV 2
        cy% = y% DIV 3
        chr%=GET(cx%,cy%) AND &5F
        C%=(x% AND 1)+(y% MOD 3)*2
        C%=2^C% - (C%=5)*32
        CASE cmd% OF
          WHEN 0:chr% AND=(&5F - C%)
          WHEN 1:chr% OR=C%
          WHEN 2:chr% EOR=C%
        ENDCASE

        VDU 31,cx%, cy%,(chr%+160)
      ENDIF

      ENDPROC

      REM LINE ROUTINE USE m% TO PERFORM 0=ERASE / 1=DRAW / 2=EOR
      DEF PROCbresenham(x1%,y1%,x2%,y2%,m%)
      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
        PROCpoint(x1%,y1%,m%)
        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

      REM LINE ROUTINE USE m% TO PERFORM 0=ERASE / 1=DRAW / 2=EOR
      DEF PROCbresenham2(x1%,y1%,x2%,y2%,m%)
      LOCAL oldframe%,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
      oldframe%=frame%
      REPEAT
        PROCpoint(x1%,y1%,m%)
        PROCloadnextframe(1,1)
        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
      frame%=oldframe%-1
      PROCloadnextframe(1,0)
      ENDPROC

      REM RECTANGLE ROUTINE
      DEF PROCrectangle(x1%,y1%,x2%,y2%,m%)

      REM CHECK FOR SPECIAL CASES TO PRESERVE EOR OPERATIONS
      IF x1%=x2% AND y1%=y2% THEN
        PROCpoint(x1%,y1%,m%)
      ELSE
        IF x1%=x2% OR y1%=y2% THEN
          PROCbresenham(x1%,y1%,x2%,y2%,m%)
        ELSE
          PROCbresenham(x1%,y1%,x2%,y1%,m%)
          PROCbresenham(x1%,y2%,x2%,y2%,m%)
          IF ABS(y2%-y1%)>1 THEN
            IF y1%>y2% THEN SWAP y1%,y2%
            FOR Y%=y1%+1 TO y2%-1
              PROCpoint(x1%,Y%,m%)
              PROCpoint(x2%,Y%,m%)
            NEXT
          ENDIF
        ENDIF
      ENDIF
      ENDPROC

      REM CIRCLE ROUTINE
      DEF PROCcircle(x1%,y1%,r%,m%)
      LOCAL p,x%,y%

      r%=ABS(r%)
      p=(5-r%*4)/4
      x%=0
      y%=r%

      PROCcirclepoints(x1%,y1%,x%,y%,m%)

      WHILE x%<y%
        x%+=1
        IF p<0 THEN
          p+=2*x%+1
        ELSE
          y%-=1
          p+=2*(x%-y%)+1
        ENDIF
        PROCcirclepoints(x1%,y1%,x%,y%,m%)
      ENDWHILE

      ENDPROC

      REM THIS PLOTS THE POINTS FOR CIRCLE ROUTINE
      DEF PROCcirclepoints(cx%,cy%,x%,y%,m%)
      IF x%=0 THEN
        PROCpoint(cx%,cy%+y%,m%)
        PROCpoint(cx%,cy%-y%,m%)
        PROCpoint(cx%+y%,cy%,m%)
        PROCpoint(cx%-y%,cy%,m%)
      ELSE
        IF x%<=y% THEN
          PROCpoint(cx%+x%,cy%+y%,m%)
          PROCpoint(cx%-x%,cy%+y%,m%)
          PROCpoint(cx%+x%,cy%-y%,m%)
          PROCpoint(cx%-x%,cy%-y%,m%)
          IF x%<y% THEN
            PROCpoint(cx%+y%,cy%+x%,m%)
            PROCpoint(cx%-y%,cy%+x%,m%)
            PROCpoint(cx%+y%,cy%-x%,m%)
            PROCpoint(cx%-y%,cy%-x%,m%)
          ENDIF
        ENDIF
      ENDIF
      ENDPROC

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

      IF sx%>xMin% AND sx%<xMax% AND sy%>yMin% AND sy%<yMax% 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 FNpoint(x%,y%) = 0 THEN

            uf=1 : df=1

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

            REM scan right
            WHILE x%<fxMax% AND FNpoint(x%,y%) = 0
              PROCpoint(x%,y%,1)

              REM detect colour changes above and add to list
              IF y%<fyMax% THEN
                c%=FNpoint(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%=FNpoint(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

      REM UPDATE CLEARSCREEN OPTIONS
      DEF PROCupdateCS
      PRINTTAB(5,7)"FORE  ";CHR$(234);SPC(17);CHR$(181);
      PRINTTAB(5,9)"BACK  ";CHR$(234);SPC(17);CHR$(181);

      IF bakcol%=0 THEN PRINTTAB(13,9)"B"

      FOR I%=1 TO 7
        PRINTTAB(12+I%*2,7)CHR$(144+I%);CHR$(255+(I%=curcol%)*185);
        PRINTTAB(12+I%*2,9)CHR$(144+I%);CHR$(255+(I%=bakcol%)*189);
      NEXT

      PRINTTAB(5,11)"OUTPUT";
      IF bakcol%>0 THEN
        VDU 144+bakcol%,157,144+curcol%
      ELSE
        VDU 32,32,144+curcol%
      ENDIF
      PRINTTAB(14,11)"abcdefghijklmno";CHR$(156);CHR$(151)

      ENDPROC

      REM CLEARSCREEN DIALOG
      DEF PROCclearscreen
      PROCundosave
      PROCWAITMOUSE(0)

      FOR L%=5 TO 18
        PRINTTAB(0,L%)SPC(40);
      NEXT

      PRINTTAB(2,5)CHR$(151);CHR$(232);STRING$(9,CHR$(172));CHR$(130);"CLEARSCREEN";CHR$(151);STRING$(9,CHR$(172));CHR$(180);
      FOR L%=6 TO 17
        PRINTTAB(2,L%)CHR$(151);CHR$(234);STRING$(30," ");CHR$(151);CHR$(181);
      NEXT

      PRINTTAB(5,13)CHR$(146);CHR$(157);CHR$(132);"ALL FRAMES  ";CHR$(156);" ";CHR$(145);CHR$(157);CHR$(131);"CANCEL  ";CHR$(156);

      PRINTTAB(5,14)CHR$(129);STRING$(25,"-")
      PRINTTAB(5,16)CHR$(146);CHR$(157);CHR$(132);"DUPE FRAME  ";CHR$(156);

      PRINTTAB(2,18)CHR$(151);CHR$(170);STRING$(31,CHR$(172));CHR$(165);

      PROCupdateCS

      done%=0
      col_old%=curcol%
      bak_old%=bakcol%
      REPEAT
        PROCREADMOUSE
        IF MB%=4 THEN
          REPEAT
            PROCREADMOUSE
            IF TY%=7 THEN
              IF TX%>13 AND TX%<28 THEN curcol%=(TX%-12) DIV 2
            ENDIF
            IF TY%=9 THEN
              IF TX%>11 AND TX%<28 THEN bakcol%=(TX%-12) DIV 2
            ENDIF

            IF TY%=13 THEN
              IF TX%>5 AND TX%<20 THEN done%=1
              IF TX%>23 AND TX%<33 THEN done%=-1
            ENDIF

            IF TY%=16 THEN
              IF TX%>5 AND TX%<20 THEN done%=2
            ENDIF
          UNTIL MB%=0
          IF col_old%<>curcol% OR bak_old%<>bakcol% THEN
            PROCupdateCS
            col_old%=curcol%
            bak_old%=bakcol%

          ENDIF
        ENDIF
      UNTIL done%

      PROCWAITMOUSE(0)

      CASE done% OF
        WHEN 0: PROCundorestore : REM CANCEL

        WHEN 1: REM NEW BACKGROUND COLOUR

          PROCGR(curcol%,bakcol%)

          FOR frame%=1 TO frame_max%
            PROCframesave(frame%)
            REM WAIT 10
          NEXT frame%
          frame%=1

        WHEN 2: REM DUPLICATE FRAME 1
          PROCundorestore
          PROCframesave(1)
          frame%=0
          PROCloadnextframe(1,0)
          FOR frame%=2 TO frame_max%
            PROCframesave(frame%)
            REM WAIT 10
          NEXT frame%
          frame%=1

      ENDCASE
      REMPROCloadnextframe(1,0)

      ENDPROC

      REM SAVE FRAME BUFFER
      DEF PROCframesave(f%)
      LOCAL U%

      FOR U%=0 TO 959
        FRAME_BUFFER(f%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM RESTORE FRAME BUFFER
      DEF PROCframerestore(f%)
      LOCAL U%

      FOR U%=0 TO 959
        VDU 31,(U% MOD 40),(U% DIV 40+1),FRAME_BUFFER(f%,U%)
      NEXT

      ENDPROC

      DEF PROCloadnextframe(F%,S%)

      IF S% THEN
        PROCWAITMOUSE(0)
        PROCframesave(frame%)
      ENDIF
      frame%+=F%
      IF frame%>frame_max% THEN frame%=1
      IF frame%<1 THEN frame%=frame_max%
      PROCframerestore(frame%)
      PROCdrawmenu
      ENDPROC

      REM SAVE UNDO SCREEN
      DEF PROCundosave
      LOCAL U%
      UNDO_INDEX%+=1
      IF UNDO_INDEX%>UNDO_MAX% THEN UNDO_INDEX%=0

      FOR U%=0 TO 959
        UNDO_BUFFER(UNDO_INDEX%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM SAVE UNDO SCREEN
      DEF PROCundorestore
      LOCAL U%

      FOR U%=0 TO 959
        VDU 31,(U% MOD 40),(U% DIV 40+1),UNDO_BUFFER(UNDO_INDEX%,U%)
      NEXT

      UNDO_INDEX%-=1
      IF UNDO_INDEX%<0 THEN UNDO_INDEX%=UNDO_MAX%

      ENDPROC

      REM SAVE BINARY FILE
      DEF PROCsavebinaryfile(F$)
      f%=OPENOUT(F$)
      FOR U%=0 TO 999
        BPUT#f%,GET(U% MOD 40,U% DIV 40)
      NEXT
      CLOSE#f%
      ENDPROC

      REM LOAD BINARY FILE
      DEF PROCloadbinaryfile(F$)
      f%=OPENIN(F$)

      FOR U%=0 TO 999
        char%=BGET#f%
        VDU 31,U% MOD 40,U% DIV 40,char%
      NEXT
      CLOSE#f%
      ENDPROC


      REM LOADFILE
      DEF PROCloadfile

      LOCAL N%
      DIM n$(10000)

      N% = FN_dirscan(n$(), "dir *.*", "", "", "")


      PROCWAITMOUSE(0)
      PROCundosave
      FOR L%=6 TO 18
        PRINTTAB(0,L%)SPC(40);
      NEXT


      PRINTTAB(2,6)CHR$(151);CHR$(232);STRING$(10,CHR$(172));CHR$(130);"LOAD FILE";CHR$(151);STRING$(10,CHR$(172));CHR$(180);
      FOR L%=7 TO 17
        PRINTTAB(2,L%)CHR$(151);CHR$(234);STRING$(30," ");CHR$(151);CHR$(181);
      NEXT
      PRINTTAB(2,18)CHR$(151);CHR$(170);STRING$(31,CHR$(172));CHR$(165);

      F%=0
      S%=0
      SEL%=0
      SELOLD%=0
      SELY%=-1
      INDEX%=1
      INDEXOLD%=1
      DC%=0


      FOR I%=INDEX% TO INDEX%+10
        IF I%<N% THEN PRINTTAB(6,6+I%)CHR$(131);LEFT$(n$(I%),24);
      NEXT

      REPEAT
        PROCREADMOUSE

        IF MB%=4 THEN
          IF MY%<>OLD_MY% THEN INDEX%+=SGN(MY%-OLD_MY%)
          IF INDEX%<1 THEN INDEX%=1
          IF INDEX%>N%-10 THEN INDEX%=N%-10
          IF SELY%=-1 THEN SELY%=MY%

        ENDIF

        IF MB%=0 THEN
          IF SELY%=MY% THEN
            S%=TY%-7
            IF S%>-1 AND S%<11 THEN SEL%=S%+INDEX%
            IF SEL%<1 THEN SEL%=1
            IF SEL%>N% THEN SEL%=N%
            F%=SEL%
            IF TX%<6 OR TX%>32 OR TY%<7 OR TY%>17 THEN F%=-1
          ENDIF
          SELY%=-1
        ENDIF

        IF INDEX%<>INDEXOLD% OR SELOLD%<>SEL% THEN
          FOR I%=0 TO 10
            K%=I%+INDEX%
            PRINTTAB(4,I%+7)SPC(30);
            IF K%<N%+1 THEN
              VDU 31,4,I%+7
              IF SEL%=K% THEN
                VDU 132,157
              ELSE
                VDU 32,32
              ENDIF
              PRINTCHR$(131);LEFT$(n$(K%),24);
              IF SEL%=K% THEN VDU 32,32,156
            ENDIF
          NEXT
          SELOLD%=SEL%
          INDEXOLD%=INDEX%
        ENDIF

        REM PRINTTAB(0,1)STR$(SEL%)

        OLD_MY%=MY%


        WAIT 2
      UNTIL F%<>0

      PROCundorestore

      IF F%>0 THEN
        IF LEFT$(n$(SEL%),3)="M7_" THEN
          F$=LEFT$(n$(SEL%),22)
          FOR frame%=1 TO frame_max%
            REM PROCloadsave7("load """ + F$ + STR$(frame%)+".RAW"" " + STR$~@chrmap% + " +3200")
            PROCloadbinaryfile(F$ + STR$(frame%)+".BIN")
            PROCframesave(frame%)
            REM WAIT 10
          NEXT
          PROCloadnextframe(1,0)
        ELSE

        ENDIF
      ENDIF
      ENDPROC

      REM SAVEFILE
      DEF PROCsavefile
      PROCWAITMOUSE(0)

      PROCframesave(frame%)

      REM SAVE FRAMES
      T$=TIME$
      C%=FN_findreplace(T$, ".", "", 1)
      C%=FN_findreplace(T$, " ", "", 1)
      C%=FN_findreplace(T$, ",", "", 1)
      C%=FN_findreplace(T$, ":", "", 1)

      frame%=frame_max%
      FOR I%=1 TO frame_max%
        PROCloadnextframe(1,0)
        PROCsavebinaryfile("M7_" + T$ + "_" + STR$(frame%)+".BIN")
        REM PROCloadsave7("save ""M7_" + T$ + "_" + STR$(frame%)+".RAW"" " + STR$~@chrmap% + " +3200")
        OSCLI "SCREENSAVE ""M7_" + T$ + "_" + STR$(frame%)+".BMP"" 0,0,1279,999"
        WAIT 10
      NEXT

      PROCloadnextframe(1,0)

      PROCundosave
      PRINTTAB(9,10)CHR$(151);CHR$(232);STRING$(18,CHR$(172));CHR$(180);CHR$(144+curcol%);
      FOR L%=11 TO 13
        PRINTTAB(9,L%)CHR$(151);CHR$(234);STRING$(17," ");CHR$(151);CHR$(181);CHR$(144+curcol%);
      NEXT
      PRINTTAB(9,14)CHR$(151);CHR$(170);STRING$(18,CHR$(172));CHR$(165);CHR$(144+curcol%);

      REM READ FILES
      PRINTTAB(13,12)CHR$(130);"FILE SAVED!";

      PROCWAITMOUSE(4)

      PROCWAITMOUSE(0)

      PROCundorestore

      ENDPROC

      DEF PROCloadsave7(F$)
      *HEX 64
      OSCLI F$

      REM REFRESH THE SCREEN FOR *LOAD
      IF LEFT$(F$,4)="load" THEN VDU 23,18,3|

      ENDPROC

      DEF PROCplay
      PROCWAITMOUSE(0)

      D%=0

      frame%=frame_max%
      REPEAT
        PROCloadnextframe(1,0)
        FOR I%=0 TO 9
          PROCREADMOUSE
          IF MB%<>0 THEN D%=1
          WAIT 2
        NEXT
      UNTIL D%
      PROCWAITMOUSE(0)
      ENDPROC

      REM INITIALISE THE SCREEN
      DEF PROCGR(F%,B%)

      REM CLS
      VDU 12

      REM ADD GRAPHICS CODE TO LEFT SIDE OF CANVAS
      FOR Y%=1 TO 24
        VDU 31,0,Y%
        IF B% THEN VDU 128+B%,157
        VDU 144+F%
      NEXT

      ENDPROC

      REM PRINT PALETTE AND MENU
      DEF PROCdrawmenu
      FOR count%=1 TO 7
        PRINTTAB(count%*2-2,0) CHR$(128+count%);CHR$(255+(count%=curcol%)*213);
      NEXT count%
      PRINTTAB(14,0) CHR$(135);"PD";STR$(dither%+1);"U";CHR$(135-erase%*5);"E";CHR$(135);"CBF ORLF LS";CHR$(135-animation%*5);"A";CHR$(135);STR$(frame%);"<>P"
      IF menuext% THEN PRINTTAB(0,1)" Animation Tools:";CHR$(135-animateline%*5);"L";SPC(21);
      ENDPROC

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

Re: Teletext paint program

Post by pixelblip » Tue Aug 25, 2020 6:45 am

You are amazing!
What a pleasure to wake up nowadays!
I’ll test those thank you so much.
As for the foreground and background maybe a toggle is a good idea as I am not sure how it would all work in practice.
I can wait to try it all out. Thanks a bunch!

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

Re: Teletext paint program

Post by pixelblip » Tue Aug 25, 2020 12:42 pm

I did a quick animation at lunch.
I made a gif from the bmps but it cut two of the top lines off ....just reporting it incase. It's great being able to animation.
Attachments
Animation.gif

Post Reply

Return to “programming”