Teletext paint program

bbc micro/electron/atom/risc os coding queries and routines
User avatar
FourthStone
Posts: 1030
Joined: Thu Nov 17, 2016 2:29 am
Location: Brisbane, Australia
Contact:

Re: Teletext paint program

Post by FourthStone » Sat Aug 29, 2020 6:28 am

pixelblip wrote:
Sat Aug 29, 2020 1:11 am
We had a week of 33c and I have to say it was such a treat.....

Thanks for adding that feature. 🙏
The max scroll offset. Ummm.....not sure. I guess if we have 8 frames it will be 40/8....So that is 5 characters.
Ok you can wish me happy birthday now. I plan on going for a greasy spoon...and doing some teletext paintings of course :)
Happy Birthday! Code update about with scrolling added, there's a bug with negative values but positive values work fine and you can use both together for diagonal scrolling.

Enjoy :D

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

Re: Teletext paint program

Post by pixelblip » Sat Aug 29, 2020 6:55 am

That is the best birthday present I could get. Well done and thank you!

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

Re: Teletext paint program

Post by pixelblip » Sat Aug 29, 2020 6:57 am

My twin’s simple bday card
Attachments
37D14F6C-382E-4F4B-9260-E486DA9CF63F.gif

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

Re: Teletext paint program

Post by pixelblip » Sat Aug 29, 2020 6:02 pm

Simple Scrolling
Attachments
Walk.gif

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

Re: Teletext paint program

Post by pixelblip » Sat Aug 29, 2020 6:06 pm

It would be nice to be able to colour that scrolling picture.......you could do it one frame at a time.....it would be cool if you could do colour one frame and duplicate the first 3 columns on the left to all the pics....
It would be better to do that after the animation is complete and has been set up - that way the control codes stay as they are.

I do hope now I have asked for that scrolling I can put it to good use. That is cool you added diagonal scrolling as well.

I think even though it is simple it is quite cool.

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

Re: Teletext paint program

Post by FourthStone » Sat Aug 29, 2020 11:57 pm

Update to clean up the scrolling bugs, works in both directions now.

Added a CLS toggle in the clear screen window, this will allow adding colour to frames after drawing and or animating. To make the programming easier keep in mind that what ever frame is active when applying color or animation becomes frame one. The easiest way to make sure no errors occur is to only apply colour or animation while drawing on frame 1, then apply the effects to other frames.

I haven't added a copy colour toggle as yet, will look at this next time.

*** EDIT *** Fixed background plot bug and added new dither pattern '6' for separated graphics, '5' for solid block, '1..4' dither pixels.

*** EDIT2 *** Added:
* Control code menu under the 'F' menu, I haven't finished the selector logic as yet, have a look and let me know thoughts?
* Undo and Redo now work in unison, undoing an action enables the redo tool action, have limited undo / redo to 20 items and it is still not frame aware, I need to either cancel all undo / redo if changing frame or try to keep track of all changes across all frames, first option is simpler.
* Squished a few bugs, the more we use it, the better we can deal with unexpected conditions =D>

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 *** LOAD SCREEN SORT BY NEWEST, NEEDS WORK!

      REM *** COPY AND PASTE

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

      REM *** IMPLEMENT ANIMATED CIRCLE

      REM *** CONTROL CODE SUB MENU TO ALLOW ALL AVAILABLE CONTROL CODES TO BE PLOTTED

      REM *** TODO LIST ***

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

      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 BUFFER ARRAY
      UNDO_MAX%=19
      DIM UNDO_BUFFER(UNDO_MAX%,959)
      UNDO_INDEX%=0

      REM REDO BUFFER ARRAY
      DIM REDO_BUFFER(UNDO_MAX%,959)
      REDO_INDEX%=0

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

      REM MENU BUFFER
      DIM MENU_BUFFER(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
      shapesel%=1
      toolcursor%=15
      animateshape%=0
      animategap%=0
      animategapcount%=0
      animatelen%=1
      animatelencount%=0
      scrollh%=0
      scrollv%=0
      erase%=0
      dither%=0
      frame%=1
      animation%=0
      menuext%=0

      REM FILE DIALOG
      N%=0

      PROCGR(curcol%,bakcol%,1)
      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
              PROCWAITMOUSE(0)
              IF TY%=0 THEN
                CASE TX% OF
                  WHEN 0: REM OPTIONS MENU
                  WHEN 1,2: curcol%=1:PROCmenurestore : REM RED
                  WHEN 3,4: curcol%=2:PROCmenurestore : REM GREEN
                  WHEN 5,6: curcol%=3:PROCmenurestore : REM YELLOW
                  WHEN 7,8: curcol%=4:PROCmenurestore : REM BLUE
                  WHEN 9,10: curcol%=5:PROCmenurestore : REM MAGENTA
                  WHEN 11,12: curcol%=6:PROCmenurestore : REM CYAN
                  WHEN 13,14: curcol%=7:PROCmenurestore : REM WHITE

                  WHEN 15: toolsel%=1:toolcursor%=TX% : REM PAINT
                  WHEN 16: toolsel%=2:toolcursor%=TX% : REM DITHER
                  WHEN 17: dither%=(dither%+1) MOD 6:toolsel%=2:toolcursor%=16:PROCmenurestore : REM DITHER SCALE
                  WHEN 18: toolsel%=3:toolcursor%=TX% : REM FILL
                  WHEN 19: toolsel%=4:toolcursor%=TX% : REM SHAPE MENU
                    IF menuext%<>1 THEN
                      IF menuext%=0 THEN PROCmenusave
                      menuext%=1
                    ELSE
                      PROCmenurestore
                    ENDIF

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

                  WHEN 23: PROCmenurestore:PROCundorestore : REM UNDO
                  WHEN 25: PROCmenurestore:PROCredorestore : REM REDO

                  WHEN 27: PROCmenurestore:PROCclearscreen:toolsel%=1:toolcursor%=15 : REM CLEARSCREEN
                  WHEN 28: toolsel%=5:toolcursor%=TX% : REM BACKGROUND COLOUR
                  WHEN 29: toolsel%=6:toolcursor%=TX% : REM FORGROUND AND CONTROL CODE MENU
                    IF menuext%<>2 THEN
                      IF menuext%=0 THEN PROCmenusave
                      menuext%=2
                    ELSE
                      PROCmenurestore
                    ENDIF

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

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

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


                ENDCASE

                REM HIDE SHAPE MENU IF ANOTHER TOOL IS SELECTED
                IF toolsel%<>4 AND menuext%=1 THEN PROCmenurestore
                IF toolsel%<>6 AND menuext%=2 THEN PROCmenurestore

                PROCdrawmenu
              ENDIF
            ENDIF

          ELSE
            REM CHECK IF EXTENDED MENU IS ACTIVE
            IF menuext% AND TY%=1 THEN
              IF MB%=4 THEN
                CASE TX% OF
                  WHEN 0: shapesel%=1 : REM LINE
                  WHEN 1: shapesel%=2 : REM RECTANGLE
                  WHEN 2: shapesel%=3 : REM CIRCEL

                  WHEN 4: animateshape%=(animateshape%+1) AND 1 : REM ANIMATEDSHAPE
                  WHEN 11:  REM ANIMATED GAP DECREMENT
                    animategap%-=1
                    IF animategap%<0 THEN animategap%=0
                  WHEN 15:  REM ANIMATED GAP INCREMENT
                    animategap%+=1
                    IF animategap%>5 THEN animategap%=5
                  WHEN 22:  REM ANIMATED LEN DECREMENT
                    animatelen%-=1
                    IF animatelen%<1 THEN animatelen%=1
                  WHEN 26:  REM ANIMATED LEN INCREMENT
                    animatelen%+=1
                    IF animatelen%>5 THEN animatelen%=5

                ENDCASE

                PROCWAITMOUSE(0)
                PROCdrawmenu

              ENDIF

            ELSE

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

                  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
                          CASE dither% OF
                            WHEN 4 : char%=255+(erase%=1)*95 : REM SOLID BLOCK #255
                            WHEN 5 : char%=154-erase% : REM SEPARATED GRAPHICS #154 , CONTIGUOUS $153

                          ENDCASE
                          VDU 31,TX%,TY%,char%
                        ENDIF
                      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
                              CASE dither% OF
                                WHEN 4 : char%=255+(erase%=1)*95 : REM SOLID BLOCK #255
                                WHEN 5 : char%=154-erase% : REM SEPARATED GRAPHICS #154 , CONTIGUOUS $153

                              ENDCASE
                              VDU 31,TX%,TY%,char%
                            ENDIF
                          ENDIF
                        ENDIF
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

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

                    WHEN 4: REM SHAPE TOOLS
                      CASE shapesel% OF
                        WHEN 1: 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%,2)
                          IF animateshape% THEN
                            oldframe%=frame%
                            PROCframesave(frame%)
                            PROCbresenham_buf(startx%,starty%,PX%,PY%,1-erase%)
                            frame%=oldframe%-1
                            PROCloadnextframe(1,0)
                          ELSE
                            PROCbresenham(startx%,starty%,PX%,PY%,1-erase%)
                            IF animation% THEN PROCloadnextframe(1,1)
                          ENDIF

                        WHEN 2: 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%,2)
                          IF animateshape%=1 THEN
                            oldframe%=frame%
                            PROCframesave(frame%)
                            PROCrectangle_buf(startx%,starty%,PX%,PY%,1-erase%)
                            frame%=oldframe%-1
                            PROCloadnextframe(1,0)
                          ELSE
                            PROCrectangle(startx%,starty%,PX%,PY%,1-erase%)
                            IF animation% THEN PROCloadnextframe(1,1)
                          ENDIF

                        WHEN 3: 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)

                      ENDCASE

                    WHEN 5: REM BACKGROUND COLOUR
                      PROCundosave
                      IF TX%<39 THEN VDU 31,TX%,TY%,(curcol%+144),157-erase%
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN
                          IF TX%<39 VDU 31,TX%,TY%,(curcol%+144),157-erase%
                        ENDIF
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)
                    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
                      IF animation% THEN PROCloadnextframe(1,1)


                  ENDCASE


              ENDCASE

            ENDIF
          ENDIF

        ELSE
          IF INKEY(-26) THEN PROCWAITNOKEY(-26) : PROCloadnextframe(-1,1) : REM SAVE CURRENT FRAME AND LOAD PREVIOUS FRAME
          IF INKEY(-122) THEN PROCWAITNOKEY(-122) : PROCloadnextframe(1,1) : REM SAVE CURRENT FRAME AND LOAD NEXT FRAME

          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
        IF menuext%=1 THEN
          VDU 31,shapesel%-1,1
        ELSE
          VDU 31,toolcursor%,0
        ENDIF
      ENDIF


      ENDPROC

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

      REM WAIT FOR NO KEY INPUT
      DEF PROCWAITNOKEY(W%)
      REPEAT

      UNTIL INKEY(W%)=0
      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 Read the point at the specified coordinates from specified buffer (1=set, 0=cleared)
      DEFFNpoint_buf(x%,y%,f%)
      LOCAL cx%,cy%,chr%,C%
      REM Get character cell
      cx% = x% DIV 2
      cy% = (y% DIV 3)-1
      chr%=FRAME_BUFFER(f%,cx%+cy%*40) 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 from specified buffer
      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_buf(x%, y%, cmd%,f%)

      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)-1
        chr%=FRAME_BUFFER(f%,cx%+cy%*40) 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

        FRAME_BUFFER(f%,cx%+cy%*40)=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 FOR BUFFER USE m% TO PERFORM 0=ERASE / 1=DRAW / 2=EOR
      DEF PROCbresenham_buf(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
        IF animategapcount%=0 THEN
          PROCpoint_buf(x1%,y1%,m%,frame%)
          frame%=frame%+1
          IF frame%>frame_max% THEN frame%=1
        ELSE
          animategapcount%-=1
        ENDIF
        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 RECTANGLE ROUTINE FOR BUFFER
      DEF PROCrectangle_buf(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_buf(x1%,y1%,x2%,y2%,m%)
        ELSE
          IF x1%>x2% THEN SWAP x1%,x2%
          IF y1%>y2% THEN SWAP y1%,y2%
          PROCbresenham_buf(x1%,y1%,x2%,y1%,m%)
          PROCbresenham_buf(x2%,y1%+1,x2%,y2%-1,m%)
          PROCbresenham_buf(x2%,y2%,x1%,y2%,m%)
          PROCbresenham_buf(x1%,y2%-1,x1%,y1%+1,m%)
        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
      LOCAL I%

      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
      LOCAL I%,L%,A$,B$,cls%,done%,col_old%,bak_old%,h_old%,v_old%,hindex%,vindex%

      PROCmenusave : menuext%=99
      PROCWAITMOUSE(0)

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

      PRINTTAB(1,5)CHR$(151);CHR$(232);STRING$(10,CHR$(172));CHR$(130);"CLEARSCREEN";CHR$(151);STRING$(10,CHR$(172));CHR$(180);
      FOR L%=6 TO 19
        PRINTTAB(1,L%)CHR$(151);CHR$(234);STRING$(32," ");CHR$(151);CHR$(181);
      NEXT

      cls%=1
      PRINTTAB(5,13)CHR$(134);"CLS:";CHR$(130);"Y";
      PRINTTAB(4,14)CHR$(146);CHR$(157);CHR$(132);"ALL FRAMES  ";CHR$(156);" ";CHR$(145);CHR$(157);CHR$(131);" CANCEL   ";CHR$(156);

      PRINTTAB(4,15)CHR$(129);STRING$(29,"-")

      PRINTTAB(4,16)CHR$(132);"SCROLL OFFSET:  ";CHR$(134);"HORZ   VERT"
      A$=STR$(scrollh%)
      IF LEN(A$)<2 THEN A$=A$+" "
      B$=STR$(scrollv%)
      IF LEN(B$)<2 THEN B$=B$+" "

      PRINTTAB(4,17)CHR$(146);CHR$(157);CHR$(132);"DUPE FRAME  ";CHR$(156);CHR$(135)+"-"+CHR$(131)+A$+CHR$(135)+"+ -"+CHR$(131)+B$+CHR$(135)+"+"

      PRINTTAB(1,19)CHR$(151);CHR$(170);STRING$(33,CHR$(172));CHR$(165);

      PROCupdateCS

      done%=0
      col_old%=curcol%
      bak_old%=bakcol%
      h_old%=scrollh%
      v_old%=scrollv%

      REPEAT
        PROCREADMOUSE
        IF MB%=4 THEN
          PROCWAITMOUSE(0)
          CASE TY% OF
            WHEN 0,1,2,3,4 : done%=-1
            WHEN 7  : REM FORGROUND COLOUR SELECTOR
              IF TX%>13 AND TX%<28 THEN curcol%=(TX%-12) DIV 2

            WHEN 9 : REM BACKGROUND COLOUR SELECTOR
              IF TX%>11 AND TX%<28 THEN bakcol%=(TX%-12) DIV 2

            WHEN 13  : REM TOGGLE CLS
              IF TX%=11 THEN
                cls%=(cls%+1) AND 1
                PRINTTAB(10,13);CHR$(129+cls%);CHR$(78+cls%*11); : REM TOGGLE CLS
              ENDIF

            WHEN 14
              IF TX%>5 AND TX%<20 THEN done%=1 : REM SELECT CLEARSCREEN AND FINISH
              IF TX%>23 AND TX%<34 THEN done%=-1 : REM CANCEL SCLEARSCREEN DIALOG
            WHEN 17
              IF TX%>5 AND TX%<20 THEN done%=2 : REM SELECT DUPE SCREEN AND FINISH

              CASE TX% OF
                WHEN 21 : REM HORIZONTAL DECREMENT
                  scrollh%-=1
                  IF scrollh%<-5 THEN scrollh%=-5
                WHEN 26 : REM HORIZONTAL INCREMENT
                  scrollh%+=1
                  IF scrollh%>5 THEN scrollh%=5
                WHEN 28 : REM VERTICAL DECREMENT
                  scrollv%-=1
                  IF scrollv%<-3 THEN scrollv%=-3
                WHEN 33 : REM VERTICAL INCREMENT
                  scrollv%+=1
                  IF scrollv%>3 THEN scrollv%=3
              ENDCASE
            WHEN 20,21,22,23,24 : done%=-1

          ENDCASE
          IF col_old%<>curcol% OR bak_old%<>bakcol% THEN
            PROCupdateCS
            col_old%=curcol%
            bak_old%=bakcol%

          ENDIF
          IF h_old%<>scrollh% THEN
            A$=STR$(scrollh%)
            IF LEN(A$)<2 THEN A$=A$+" "
            PRINTTAB(23,17)A$;
            h_old%=scrollh%
          ENDIF
          IF v_old%<>scrollv% THEN
            A$=STR$(scrollv%)
            IF LEN(A$)<2 THEN A$=A$+" "
            PRINTTAB(30,17)A$;
            v_old%=scrollv%
          ENDIF

        ENDIF
      UNTIL done%

      PROCWAITMOUSE(0)

      PROCmenurestore
      CASE done% OF
        WHEN -1:  REM CANCEL

        WHEN 1: REM NEW BACKGROUND COLOUR
          PROCGR(curcol%,bakcol%,cls%)
          IF cls% THEN
            FOR frame%=1 TO frame_max%
              PROCframesave(frame%)
              REM WAIT 10
            NEXT frame%
            frame%=1
          ELSE
            PROCframesave(1)
            frame%=1

            FOR I%=2 TO 8
              PROCGR_BUF(I%,curcol%,bakcol%)
            NEXT

          ENDIF

        WHEN 2: REM DUPLICATE FRAME 1
          PROCframesave(1)
          frame%=0
          PROCloadnextframe(1,0)
          hindex%=scrollh%
          vindex%=scrollv%
          FOR frame%=2 TO frame_max%
            IF scrollh%<>0 OR scrollv%<>0 THEN
              PROCcopyframe(1,frame%,hindex%,vindex%)
              hindex%+=scrollh%
              vindex%+=scrollv%
            ELSE
              PROCframesave(frame%)
            ENDIF
          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

      REM COPY A FRAME STARTING FROM OFFSET
      DEF PROCcopyframe(S%,D%,H%,V%)
      LOCAL U%,X%,Y%,xofs%,yofs%

      FOR X%=1 TO 39
        xofs%=X%+H%
        IF xofs%<1 THEN xofs%=39+xofs%
        IF xofs%>39 THEN xofs%=xofs%-39
        FOR Y%=0 TO 23
          yofs%=Y%+V%
          IF yofs%<0 THEN yofs%=23+yofs%
          IF yofs%>23 THEN yofs%=yofs%-24

          FRAME_BUFFER(D%,X%+Y%*40)=FRAME_BUFFER(S%,xofs%+yofs%*40)
        NEXT
      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%=UNDO_MAX%

      FOR U%=0 TO 959
        UNDO_BUFFER(UNDO_INDEX%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT
      IF UNDO_INDEX%>0 THEN PROCdrawmenu
      ENDPROC

      REM RESTORE UNDO SCREEN
      DEF PROCundorestore
      LOCAL U%

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

        UNDO_INDEX%-=1
      ENDIF

      ENDPROC

      REM SAVE REDO SCREEN
      DEF PROCredosave
      LOCAL U%
      REDO_INDEX%+=1
      IF REDO_INDEX%>UNDO_MAX% THEN REDO_INDEX%=UNDO_MAX%

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

      ENDPROC

      REM RESTORE REDO SCREEN
      DEF PROCredorestore
      LOCAL U%

      IF REDO_INDEX%>0 THEN
        FOR U%=0 TO 959
          VDU 31,(U% MOD 40),(U% DIV 40+1),REDO_BUFFER(REDO_INDEX%,U%)
        NEXT

        REDO_INDEX%-=1
        UNDO_INDEX%+=1

      ENDIF

      ENDPROC

      REM MENU BUFFER SAVE SCREEN
      DEF PROCmenusave
      LOCAL U%
      FOR U%=0 TO 959
        MENU_BUFFER(U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM MENU BUFFER UNDO SCREEN
      DEF PROCmenurestore
      LOCAL U%

      IF menuext% THEN
        FOR U%=0 TO 959
          VDU 31,(U% MOD 40),(U% DIV 40+1),MENU_BUFFER(U%)
        NEXT
        menuext%=0
      ENDIF
      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 *.BIN", "", "", "")

      REM HACK SORT, NEED TO LOOK INTO READING FILE DATES AND SORTING NEWEST FIRST
      FOR I%=1 TO N% DIV 2
        SWAP n$(I%),n$(N%-I%+1)
      NEXT

      PROCWAITMOUSE(0)
      PROCmenusave : menuext%=99
      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

        REM DETECT FIRST TOUCH OR MOVEMENT WHEN TOUCHING
        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

        REM DETECT TOUCH RELEASE
        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

        REM IF SCROLLING DETECTED UPDATE FILE LIST AND SELECTED FILE INDEX
        IF INDEX%<>INDEXOLD% OR SELOLD%<>SEL% THEN
          FOR I%=0 TO 10
            K%=I%+INDEX%
            IF K%<N%+1 AND K%>0 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

      PROCmenurestore

      IF F%>0 THEN
        IF LEFT$(FNUPPER(n$(SEL%)),3)="M7_" THEN
          F$=LEFT$(n$(SEL%),22)
          FOR frame%=1 TO frame_max%
            PROCloadbinaryfile(F$ + STR$(frame%)+".BIN")
            PROCframesave(frame%)
            REM WAIT 10
          NEXT
          PROCloadnextframe(1,0)
        ELSE
          IF RIGHT$(FNUPPER(n$(SEL%)),3)="BIN" THEN
            PROCloadbinaryfile(n$(SEL%))
            PROCframesave(frame%)
          ENDIF
        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")
        OSCLI "SCREENSAVE ""M7_" + T$ + "_" + STR$(frame%)+".BMP"" 0,0,1280,1000"
        WAIT 10
      NEXT

      PROCloadnextframe(1,0)

      PROCmenusave : menuext%=99
      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)

      PROCmenurestore

      ENDPROC

      REM ANIMATE ALL FRAMES IN SEQUENCE FROM 1 TO FRAME_MAX%
      DEF PROCplay

      PROCframesave(frame%)
      PROCWAITMOUSE(0)

      VDU 23,1,0;0;0;0; : REM Disable cursor

      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)

      VDU 23,1,1;0;0;0; : REM Enable cursor

      ENDPROC

      REM Convert to upper case:
      DEF FNUPPER(a$) IF LENa$=0 THEN =""
      LOCAL p%%
      FOR p%% = PTR(a$) TO PTR(a$)+LENa$-1
        IF ?p%% >= 97 IF ?p%% <= 122 ?p%% -= 32
      NEXT
      = a$

      REM UPDATE COLOUR STRIP FOR BUFFER
      DEF PROCGR_BUF(D%,F%,B%)

      REM ADD GRAPHICS CODE TO LEFT SIDE OF CANVAS
      FOR Y%=0 TO 23
        IF B% THEN
          FRAME_BUFFER(D%,Y%*40)=144+B%
          FRAME_BUFFER(D%,Y%*40+1)=157
          FRAME_BUFFER(D%,Y%*40+2)=144+F%
        ELSE
          FRAME_BUFFER(D%,Y%*40)=144+F%
        ENDIF
      NEXT

      ENDPROC


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

      REM CLS
      IF C% THEN VDU 12

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

      ENDPROC

      REM PRINT PALETTE AND MENU
      DEF PROCdrawmenu
      LOCAL A%,D%,E%,R%,U%
      FOR count%=1 TO 7
        PRINTTAB(count%*2-2,0) CHR$(128+count%);CHR$(255+(count%=curcol%)*213);
      NEXT count%

      A%=135-animation%*5
      D%=dither%+1
      E%=135-erase%*5
      R%=130+(REDO_INDEX%=0)
      U%=130+(UNDO_INDEX%=0)
      PRINTTAB(14,0) CHR$(135);"PD";STR$(D%);"FS";CHR$(E%);"E";CHR$(U%);"U";CHR$(R%);"R";CHR$(135);"CBF LS";CHR$(A%);"A";CHR$(135);STR$(frame%);"<>P"

      REM SHAPE MENU
      IF menuext%=1 THEN
        D%=135-animateshape%*5

        A$="LRO"+CHR$(D%)+"A"+CHR$(134)+"GAP:"+CHR$(135)+"-"+CHR$(131)+STR$(animategap%)+CHR$(135)+"+"+CHR$(134)+"LEN:"+CHR$(135)+"-"+CHR$(131)+STR$(animatelen%)+CHR$(135)+"+"

        PRINTTAB(0,1)A$;SPC(40-LEN(A$))
      ENDIF

      REM CONTROL CODE MENU
      IF menuext%=2 THEN

        A$="136"+CHR$(136)+CHR$(255)+CHR$(137)+CHR$(154)+"154"+CHR$(151)+CHR$(255)+CHR$(153)+CHR$(135)+"158"+CHR$(158)+CHR$(255)
        B$=CHR$(132)+"FLSH   SEPR   HOLD"
        PRINTTAB(0,1)A$;SPC(40-LEN(A$))
        PRINTTAB(0,2)B$;SPC(40-LEN(B$))
      ENDIF

      ENDPROC
Last edited by FourthStone on Mon Aug 31, 2020 8:32 am, edited 3 times in total.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 2:29 am

Well done.....I hope you are still finding it interesting and not a chore. There is much in place now.
It’s really great. =D>
Thanks a bunch.
You savings pics in dim statements has been such a wise choice....

It would be nice to see a copy n paste across all frames at some point if that’s not too hard to do. So after one has the scrolling background one could draw a stickman then copy and paste it across frames....almost like sprites...would make lining up easier when animating.

If one could grab an area and copy it around screen you could e.g pick a ball up and make it bounce easily.....or load a digitised pic in an animate an object over the top using copy n paste...

I’ll leave you to ponder that......more requests! :lol:

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 8:53 am

Found a bug and lost my pic....
I was painting background colours at the bottom of the pic. The pic scrolled up and I couldn’t get back to the menu. I could keep painting background colours on the iPad but no where to get the menu back. No worries.
Attachments
B66B1333-DD78-49E0-A62E-32ED16F3EEBD.png

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 8:56 am

Luckily I found a copy
Attachments
6246AA2F-F878-48C6-8946-26C2B4978CD1.jpeg

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 8:59 am

Sorry I keep firing stuff at you Fourthstone...it comes from using it :D

I know you are trying to get your head around filing .....

It would be good if a folder were created with the main session and in the save files put in there. It would save much scrolling when trying to look for work like just now....with the most recent files at the top.
Thanks a lot.

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 9:01 am

Well at least I got my wish. Sitting in bed painting Sunday morning on the iPad with a black coffee :D

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 30, 2020 11:02 am

pixelblip wrote:
Sun Aug 30, 2020 8:53 am
Found a bug and lost my pic....
I was painting background colours at the bottom of the pic. The pic scrolled up and I couldn’t get back to the menu. I could keep painting background colours on the iPad but no where to get the menu back. No worries.
Ok was able to reproduce this one, looks like when trying to do a background colour in bottom right corner there are too many codes to print in one space and so a new line is generated... bad news is that this will corrupt your picture, good news is you can still get the menu back if you click / touch the top left square... will have a look at plotting code and make sure nothing can be plotted past the last char on the bottom right.

The load menu I think I have noted it needs some work, will be looking at it at some stage this week hopefully.

Copy and paste is on the list of things to add in, this would be a great addition if I can get it working in a smart way.

The best way to find out if something is broken is to use it, it's the only way the program can improve so thanks for the feedback =D>

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 1:16 pm

It should be me thanking you!

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 30, 2020 9:45 pm

Small update re-posted above, fixed the background plot bug and added separated graphics code as dither '6'.

Thinking about control codes, I wonder if I need to add sub menu so that control codes can be easily selected, I might try this out and see what you think... added to the list!

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 9:59 pm

Look at you tackling it on a Monday morning before work!
That’s great you got sep graphics.....I like that Teletext style a lot. Thanks.

Looking at that crude man walking animation makes me think wow this program is pretty cool! Simple things are very effective.

I can see lots of space ships flying over landscapes.

Teletext does stuff that other graphic modes don’t and I like it for that...it’s very quirky.
Yeh control codes would be good....held and release graphics for simple animations.....those can be cool.

If you want to see how great teletext animation is look for hands up on youtube.... here it’s so good. https://youtu.be/eOZY5bTxXyE

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 10:29 pm

Winter scene sep graphics
Attachments
5B653B9C-24AF-42AF-A7D6-DCF7E586793A.gif

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 30, 2020 10:50 pm

The Hands Up vid is superb =D>

I imagine it would have taken a lot of time to stitch that all together!

Speaking of Winter, today is the last of winter down south and it will be 28 degrees here :D

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 11:47 pm

Hands up was all done on standard a bbc Micro.....And yes they had to stitch it together. They are amazing. I saw them all those years ago and it inspired me so much and still does.

As for winter..it’s bloody winter here at the moment. I am in scarf and hat.
The great British weather. This time last year it was record bank holiday sizzler. Now it’s like 12c. :lol:

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

Re: Teletext paint program

Post by pixelblip » Sun Aug 30, 2020 11:53 pm

Ps we need a control code that will go back to normal graphics ...rather than sep... maybe that could be no 7 ta

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

Re: Teletext paint program

Post by pixelblip » Mon Aug 31, 2020 12:03 am

Off topic but today it’s colder than Christmas Day last year here by 7c and it's summer. So stay in Brisbane.

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

Re: Teletext paint program

Post by FourthStone » Mon Aug 31, 2020 12:15 am

pixelblip wrote:
Sun Aug 30, 2020 11:53 pm
Ps we need a control code that will go back to normal graphics ...rather than sep... maybe that could be no 7 ta
Way ahead of you, select 'E' and it will erase any code you have previously drawn =D>

User avatar
Snuggsy187
Posts: 139
Joined: Wed Apr 03, 2019 9:53 pm
Contact:

Re: Teletext paint program

Post by Snuggsy187 » Mon Aug 31, 2020 12:40 am

Top work Pixelblip (and all those involved !) :D

I ran a Viewdata public information system back in the day - always struggled fitting in all those control characters around the pictures ! Would have been great having something like this back then !!

:D =D>
PUSH PARCHMENT > POKE LOCK > PULL PARCHMENT

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

Re: Teletext paint program

Post by FourthStone » Mon Aug 31, 2020 8:36 am

Snuggsy187 wrote:
Mon Aug 31, 2020 12:40 am
Top work Pixelblip (and all those involved !) :D

I ran a Viewdata public information system back in the day - always struggled fitting in all those control characters around the pictures ! Would have been great having something like this back then !!

:D =D>
Good to see others taking an interest =D> Would love to hear any feedback or suggestions if you have any?

Update posted above, added a few things and squished a couple of bugs.
FourthStone wrote:
Mon Aug 31, 2020 12:15 am
pixelblip wrote:
Sun Aug 30, 2020 11:53 pm
Ps we need a control code that will go back to normal graphics ...rather than sep... maybe that could be no 7 ta
Way ahead of you, select 'E' and it will erase any code you have previously drawn =D>
To clarify above (currently) dither pattern 6 will do separated graphics, 'D6' + 'E' will revert back to contiguous graphics on the same line.

EDIT * Have noticed a bug with scrolling if background colours are used, will need to flesh out how scrolling is handled in relation to background colours, I guess this is similar to line drawing overwriting colour codes, an option to ignore certain codes when drawing / scrolling could be very handy.

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

Re: Teletext paint program

Post by pixelblip » Mon Aug 31, 2020 10:36 am

You are right Snuggsy...for years I wanted a program like this. It’s really great and has been a joint effort from everyone.

It shows you the power of bbc basic in action. To think one can run it on an iPad or android device. Amazing! Bbc basic is keeping up with the times thanks to Richard .....

I would like to see if anyone skilled who could help Fourthstone with saving to google drive if that’s possible. It would make life much easier.

I think we are always going to hit issues with scrolling Fourthstone. It’s the control codes once they move.

Perhaps we should keep the first 3 columns on the left sacred and not to scroll if that is possible. That way we can always have a background colour.

Thanks also for that contiguous graphics tip.

This program is like Quantel paint for teletext lol

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

Re: Teletext paint program

Post by pixelblip » Mon Aug 31, 2020 10:41 am

Im back on Apple Mac. I got my old Mac mini given back to me after years. It runs surprisingly well for a 2012 computer. It’s a joy to use.
However much I hate Apple things are so well built.....it’s silent...

User avatar
Snuggsy187
Posts: 139
Joined: Wed Apr 03, 2019 9:53 pm
Contact:

Re: Teletext paint program

Post by Snuggsy187 » Mon Aug 31, 2020 11:41 am

Back in the day, I was using Editel, by Owl on an ICL 80286 Crate ! Very basic screen designer - if I remember correctly (it was 30 years ago !), all the control codes were available on function keys - the only useful thing was building up the character 2x3 pixels with the number pad..... although you soon learned the shortcuts ( , £ and p for horizontal lines for example).....

.... so anything beyond this is amazing stuff ! =D>
PUSH PARCHMENT > POKE LOCK > PULL PARCHMENT

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

Re: Teletext paint program

Post by pixelblip » Mon Aug 31, 2020 11:50 am

That is old skool.....cool......30 years ago flies by eh

I find it quite difficult to draw with anything that involves typing control codes although I have done it....with sites like edit tf

Teletext is interesting as the resolution is so limited it forces you to think differently....and say something with not a lot.....it has a bit of an Atari 2600 feel about it in terms of aesthetic if you ask me.....

The nice thing about this art program is that it will do real teletext. I have put some pics up from before on teefax -https://zxnet.co.uk/teletext/viewer/?channel=1&page=522

They are animated but quite slow......but it is real teletext. - have a look at page 566 for example....the bubbles move but slowly
I will do some more pages for teefax once I start animating.....

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

Re: Teletext paint program

Post by FourthStone » Mon Aug 31, 2020 11:12 pm

Another day, another update including:

* Clearscreen option added called 'FIX', if this is 'Y' and background colour is not black then the minimum drawing boundary is shifted past the colour codes when using standard tools like paint, dither, line, circle, fill etc. This will minimise the risk of overwriting the first 3 columns. If the background colour is set to black then the border is set to skip the first column only. Have a play around and let me know any changes or issues.

* Dupe Frame option added similar to above to skip the first 3 columns when duplicating the frames to maintain the colour codes, also tidied up the scroll code and I think it is pretty much right now and how it should be. The skip can be set from 1 to 3 so if you're not using background colour you can maximise the amount of screen usage by using a lower skip value.

Please play around with scrolling and clearscreen and let me know if there could be further improvement or if it's working as you expected.

*** EDIT *** Just noticed a small bug in the scroll code and fixed it, I added a CODE field in the 'F'roundground sub menu which shows the ascii code under the cursor, this was a great help in pinpointing the bug!

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 *** LOAD SCREEN SORT BY NEWEST, NEEDS WORK!

      REM *** COPY AND PASTE

      REM *** ADD UNDOS & REDOS FOR EACH FRAME? OR RESET UNDO IF CHANGING FRAMES

      REM *** IMPLEMENT ANIMATED CIRCLE

      REM *** CONTROL CODE SUB MENU TO ALLOW ALL AVAILABLE CONTROL CODES TO BE PLOTTED (IN PROGRESS)

      REM *** TODO LIST ***

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

      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 BUFFER ARRAY
      UNDO_MAX%=19
      DIM UNDO_BUFFER(UNDO_MAX%,959)
      UNDO_INDEX%=0

      REM REDO BUFFER ARRAY
      DIM REDO_BUFFER(UNDO_MAX%,959)
      REDO_INDEX%=0

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

      REM MENU BUFFER
      DIM MENU_BUFFER(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
      shapesel%=1
      toolcursor%=15
      animateshape%=0
      animategap%=0
      animategapcount%=0
      animatelen%=1
      animatelencount%=0
      scrollh%=0
      scrollv%=0
      erase%=0
      dither%=0
      frame%=1
      animation%=0
      menuext%=0

      REM FILE DIALOG
      N%=0

      PROCGR(curcol%,bakcol%,1)
      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
              PROCWAITMOUSE(0)
              IF TY%=0 THEN
                CASE TX% OF
                  WHEN 0: REM OPTIONS MENU
                  WHEN 1,2: curcol%=1:PROCmenurestore : REM RED
                  WHEN 3,4: curcol%=2:PROCmenurestore : REM GREEN
                  WHEN 5,6: curcol%=3:PROCmenurestore : REM YELLOW
                  WHEN 7,8: curcol%=4:PROCmenurestore : REM BLUE
                  WHEN 9,10: curcol%=5:PROCmenurestore : REM MAGENTA
                  WHEN 11,12: curcol%=6:PROCmenurestore : REM CYAN
                  WHEN 13,14: curcol%=7:PROCmenurestore : REM WHITE

                  WHEN 15: toolsel%=1:toolcursor%=TX% : REM PAINT
                  WHEN 16: toolsel%=2:toolcursor%=TX% : REM DITHER
                  WHEN 17: dither%=(dither%+1) MOD 6:toolsel%=2:toolcursor%=16:PROCmenurestore : REM DITHER SCALE
                  WHEN 18: toolsel%=3:toolcursor%=TX% : REM FILL
                  WHEN 19: toolsel%=4:toolcursor%=TX% : REM SHAPE MENU
                    IF menuext%<>1 THEN
                      IF menuext%=0 THEN PROCmenusave
                      menuext%=1
                    ELSE
                      PROCmenurestore
                    ENDIF

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

                  WHEN 23: PROCmenurestore:PROCundorestore : REM UNDO
                  WHEN 25: PROCmenurestore:PROCredorestore : REM REDO

                  WHEN 27: PROCmenurestore:PROCclearscreen:toolsel%=1:toolcursor%=15 : REM CLEARSCREEN
                  WHEN 28: toolsel%=5:toolcursor%=TX% : REM BACKGROUND COLOUR
                  WHEN 29: toolsel%=6:toolcursor%=TX% : REM FORGROUND AND CONTROL CODE MENU
                    IF menuext%<>2 THEN
                      IF menuext%=0 THEN PROCmenusave
                      menuext%=2
                    ELSE
                      PROCmenurestore
                    ENDIF

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

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

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


                ENDCASE

                REM HIDE SHAPE MENU IF ANOTHER TOOL IS SELECTED
                IF toolsel%<>4 AND menuext%=1 THEN PROCmenurestore
                IF toolsel%<>6 AND menuext%=2 THEN PROCmenurestore

                PROCdrawmenu
              ENDIF
            ENDIF

          ELSE
            REM CHECK IF EXTENDED MENU IS ACTIVE
            IF menuext% AND TY%=1 THEN
              IF MB%=4 THEN
                CASE TX% OF
                  WHEN 0: shapesel%=1 : REM LINE
                  WHEN 1: shapesel%=2 : REM RECTANGLE
                  WHEN 2: shapesel%=3 : REM CIRCEL

                  WHEN 4: animateshape%=(animateshape%+1) AND 1 : REM ANIMATEDSHAPE
                  WHEN 11:  REM ANIMATED GAP DECREMENT
                    animategap%-=1
                    IF animategap%<0 THEN animategap%=0
                  WHEN 15:  REM ANIMATED GAP INCREMENT
                    animategap%+=1
                    IF animategap%>5 THEN animategap%=5
                  WHEN 22:  REM ANIMATED LEN DECREMENT
                    animatelen%-=1
                    IF animatelen%<1 THEN animatelen%=1
                  WHEN 26:  REM ANIMATED LEN INCREMENT
                    animatelen%+=1
                    IF animatelen%>5 THEN animatelen%=5

                ENDCASE

                PROCWAITMOUSE(0)
                PROCdrawmenu

              ENDIF

            ELSE

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

                  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
                          CASE dither% OF
                            WHEN 4 : char%=255+(erase%=1)*95 : REM SOLID BLOCK #255
                            WHEN 5 : char%=154-erase% : REM SEPARATED GRAPHICS #154 , CONTIGUOUS $153

                          ENDCASE
                          VDU 31,TX%,TY%,char%
                        ENDIF
                      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
                              CASE dither% OF
                                WHEN 4 : char%=255+(erase%=1)*95 : REM SOLID BLOCK #255
                                WHEN 5 : char%=154-erase% : REM SEPARATED GRAPHICS #154 , CONTIGUOUS $153

                              ENDCASE
                              VDU 31,TX%,TY%,char%
                            ENDIF
                          ENDIF
                        ENDIF
                        OLD_PX%=PX%
                        OLD_PY%=PY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)

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

                    WHEN 4: REM SHAPE TOOLS
                      CASE shapesel% OF
                        WHEN 1: 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%,2)
                          IF animateshape% THEN
                            oldframe%=frame%
                            PROCframesave(frame%)
                            PROCbresenham_buf(startx%,starty%,PX%,PY%,1-erase%)
                            frame%=oldframe%-1
                            PROCloadnextframe(1,0)
                          ELSE
                            PROCbresenham(startx%,starty%,PX%,PY%,1-erase%)
                            IF animation% THEN PROCloadnextframe(1,1)
                          ENDIF

                        WHEN 2: 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%,2)
                          IF animateshape%=1 THEN
                            oldframe%=frame%
                            PROCframesave(frame%)
                            PROCrectangle_buf(startx%,starty%,PX%,PY%,1-erase%)
                            frame%=oldframe%-1
                            PROCloadnextframe(1,0)
                          ELSE
                            PROCrectangle(startx%,starty%,PX%,PY%,1-erase%)
                            IF animation% THEN PROCloadnextframe(1,1)
                          ENDIF

                        WHEN 3: 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)

                      ENDCASE

                    WHEN 5: REM BACKGROUND COLOUR
                      PROCundosave
                      IF TX%<39 THEN VDU 31,TX%,TY%,(curcol%+144),157-erase%
                      REPEAT
                        PROCREADMOUSE
                        IF TX%<>OLD_TX% OR TY%<>OLD_TY% THEN
                          IF TX%<39 VDU 31,TX%,TY%,(curcol%+144),157-erase%
                        ENDIF
                        OLD_TX%=TX%
                        OLD_TY%=TY%
                      UNTIL MB%=0
                      IF animation% THEN PROCloadnextframe(1,1)
                    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
                      IF animation% THEN PROCloadnextframe(1,1)


                  ENDCASE


              ENDCASE

            ENDIF
          ENDIF

        ELSE
          IF INKEY(-26) THEN PROCWAITNOKEY(-26) : PROCloadnextframe(-1,1) : REM SAVE CURRENT FRAME AND LOAD PREVIOUS FRAME
          IF INKEY(-122) THEN PROCWAITNOKEY(-122) : PROCloadnextframe(1,1) : REM SAVE CURRENT FRAME AND LOAD NEXT FRAME

          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
        IF menuext%=2 THEN
          IF OLD_TX%<>TX% OR OLD_TY%<>TY% THEN
            PRINTTAB(21,1)CHR$(131);STR$(GET(TX%,TY%))+"  "
            OLD_TX%=TX%
            OLD_TY%=TY%
          ENDIF
        ENDIF
        VDU 31,TX%,TY%
      ELSE
        IF menuext%=1 THEN
          VDU 31,shapesel%-1,1
        ELSE
          VDU 31,toolcursor%,0
        ENDIF
      ENDIF


      ENDPROC

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

      REM WAIT FOR NO KEY INPUT
      DEF PROCWAITNOKEY(W%)
      REPEAT

      UNTIL INKEY(W%)=0
      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 Read the point at the specified coordinates from specified buffer (1=set, 0=cleared)
      DEFFNpoint_buf(x%,y%,f%)
      LOCAL cx%,cy%,chr%,C%
      REM Get character cell
      cx% = x% DIV 2
      cy% = (y% DIV 3)-1
      chr%=FRAME_BUFFER(f%,cx%+cy%*40) 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 from specified buffer
      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_buf(x%, y%, cmd%,f%)

      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)-1
        chr%=FRAME_BUFFER(f%,cx%+cy%*40) 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

        FRAME_BUFFER(f%,cx%+cy%*40)=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 FOR BUFFER USE m% TO PERFORM 0=ERASE / 1=DRAW / 2=EOR
      DEF PROCbresenham_buf(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
        IF animategapcount%=0 THEN
          PROCpoint_buf(x1%,y1%,m%,frame%)
          frame%=frame%+1
          IF frame%>frame_max% THEN frame%=1
        ELSE
          animategapcount%-=1
        ENDIF
        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 RECTANGLE ROUTINE FOR BUFFER
      DEF PROCrectangle_buf(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_buf(x1%,y1%,x2%,y2%,m%)
        ELSE
          IF x1%>x2% THEN SWAP x1%,x2%
          IF y1%>y2% THEN SWAP y1%,y2%
          PROCbresenham_buf(x1%,y1%,x2%,y1%,m%)
          PROCbresenham_buf(x2%,y1%+1,x2%,y2%-1,m%)
          PROCbresenham_buf(x2%,y2%,x1%,y2%,m%)
          PROCbresenham_buf(x1%,y2%-1,x1%,y1%+1,m%)
        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
      LOCAL I%

      PRINTTAB(5,6)"FORE  ";CHR$(234);SPC(17);CHR$(181);
      PRINTTAB(5,8)"BACK  ";CHR$(234);SPC(17);CHR$(181);

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

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

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

      ENDPROC

      REM CLEARSCREEN DIALOG
      DEF PROCclearscreen
      LOCAL I%,L%,A$,B$,C$,cls%,fix%,done%,col_old%,bak_old%,h_old%,v_old%,hindex%,vindex%,skip%,skip_old%

      PROCmenusave
      menuext%=99
      cls%=1
      fix%=1
      skip%=3
      skip_old%=3

      PROCWAITMOUSE(0)

      FOR L%=4 TO 20
        PRINTTAB(0,L%)SPC(40);
      NEXT

      PRINTTAB(1,4)CHR$(151);CHR$(232);STRING$(10,CHR$(172));CHR$(130);"CLEARSCREEN";CHR$(151);STRING$(10,CHR$(172));CHR$(180);
      FOR L%=5 TO 20
        PRINTTAB(1,L%)CHR$(151);CHR$(234);STRING$(32," ");CHR$(151);CHR$(181);
      NEXT


      PRINTTAB(4,12)CHR$(132);"OPTION:  ";CHR$(134);"CLS:";CHR$(130);"Y";CHR$(134);" FIX:";CHR$(130);"Y";
      PRINTTAB(4,14)CHR$(146);CHR$(157);CHR$(132);"ALL FRAMES  ";CHR$(156);" ";CHR$(145);CHR$(157);CHR$(131);" CANCEL   ";CHR$(156);

      PRINTTAB(4,15)CHR$(129);STRING$(29,"-")

      PRINTTAB(4,16)CHR$(132);"SCROLL:  ";CHR$(134);"SKIP : HORZ : VERT"
      A$=STR$(skip%)+" "
      B$=STR$(scrollh%)
      IF LEN(B$)<2 THEN B$=B$+" "
      C$=STR$(scrollv%)
      IF LEN(C$)<2 THEN C$=C$+" "
      PRINTTAB(13,17)CHR$(135)+"-"+CHR$(131)+A$+CHR$(135)+"+"+CHR$(135)+"-"+CHR$(131)+B$+CHR$(135)+"+ -"+CHR$(131)+C$+CHR$(135)+"+"
      PRINTTAB(4,19)CHR$(146);CHR$(157);CHR$(132);"DUPE FRAME  ";CHR$(156);

      PRINTTAB(1,20)CHR$(151);CHR$(170);STRING$(33,CHR$(172));CHR$(165);

      PROCupdateCS

      done%=0
      col_old%=curcol%
      bak_old%=bakcol%
      h_old%=scrollh%
      v_old%=scrollv%
      skip_old%=skip%
      REPEAT
        PROCREADMOUSE
        IF MB%=4 THEN
          PROCWAITMOUSE(0)
          CASE TY% OF
            WHEN 0,1,2,3 : done%=-1 : REM CANCEL DIALOG
            WHEN 6  : REM FORGROUND COLOUR SELECTOR
              IF TX%>13 AND TX%<28 THEN curcol%=(TX%-12) DIV 2

            WHEN 8 : REM BACKGROUND COLOUR SELECTOR
              IF TX%>11 AND TX%<28 THEN bakcol%=(TX%-12) DIV 2

            WHEN 12  : REM TOGGLE CLS AND FIX
              IF TX%=20 THEN
                cls%=(cls%+1) AND 1
                PRINTTAB(19,12);CHR$(129+cls%);CHR$(78+cls%*11); : REM TOGGLE CLS
              ENDIF
              IF TX%=28 THEN
                fix%=(fix%+1) AND 1
                PRINTTAB(27,12);CHR$(129+fix%);CHR$(78+fix%*11); : REM TOGGLE FIX
              ENDIF

            WHEN 14
              IF TX%>5 AND TX%<20 THEN done%=1 : REM SELECT CLEARSCREEN AND FINISH
              IF TX%>23 AND TX%<34 THEN done%=-1 : REM CANCEL SCLEARSCREEN DIALOG
            WHEN 17
              CASE TX% OF
                WHEN 14 : REM HORIZONTAL DECREMENT
                  skip%-=1
                  IF skip%<1 THEN skip%=1
                WHEN 19 : REM HORIZONTAL INCREMENT
                  skip%+=1
                  IF skip%>3 THEN skip%=3
                WHEN 21 : REM HORIZONTAL DECREMENT
                  scrollh%-=1
                  IF scrollh%<-5 THEN scrollh%=-5
                WHEN 26 : REM HORIZONTAL INCREMENT
                  scrollh%+=1
                  IF scrollh%>5 THEN scrollh%=5
                WHEN 28 : REM VERTICAL DECREMENT
                  scrollv%-=1
                  IF scrollv%<-3 THEN scrollv%=-3
                WHEN 33 : REM VERTICAL INCREMENT
                  scrollv%+=1
                  IF scrollv%>3 THEN scrollv%=3
              ENDCASE
            WHEN 19 : IF TX%>5 AND TX%<20 THEN done%=2 : REM SELECT DUPE SCREEN AND FINISH

            WHEN 21,22,23,24 : done%=-1 : REM CANCEL DIALOG

          ENDCASE
          IF col_old%<>curcol% OR bak_old%<>bakcol% THEN
            PROCupdateCS
            col_old%=curcol%
            bak_old%=bakcol%

          ENDIF
          IF skip_old%<>skip% THEN
            A$=STR$(skip%)+" "
            PRINTTAB(16,17)A$;
            skip_old%=skip%
          ENDIF
          IF h_old%<>scrollh% THEN
            A$=STR$(scrollh%)
            IF LEN(A$)<2 THEN A$=A$+" "
            PRINTTAB(23,17)A$;
            h_old%=scrollh%
          ENDIF
          IF v_old%<>scrollv% THEN
            A$=STR$(scrollv%)
            IF LEN(A$)<2 THEN A$=A$+" "
            PRINTTAB(30,17)A$;
            v_old%=scrollv%
          ENDIF

        ENDIF
      UNTIL done%

      PROCWAITMOUSE(0)

      PROCmenurestore
      CASE done% OF
        WHEN -1:  REM CANCEL

        WHEN 1: REM NEW BACKGROUND COLOUR
          PROCGR(curcol%,bakcol%,cls%)
          IF cls% THEN
            FOR frame%=1 TO frame_max%
              PROCframesave(frame%)
              REM WAIT 10
            NEXT frame%
            frame%=1
          ELSE
            PROCframesave(1)
            frame%=1

            FOR I%=2 TO 8
              PROCGR_BUF(I%,curcol%,bakcol%)
            NEXT

          ENDIF
          IF fix%=1 AND bakcol%>0 THEN
            xMin%=5
            fxMin%=6
          ELSE
            xMin%=1
            fxMin%=2
          ENDIF

        WHEN 2: REM DUPLICATE FRAME 1
          PROCframesave(1)
          frame%=0
          PROCloadnextframe(1,0)
          hindex%=scrollh%
          vindex%=scrollv%
          FOR frame%=2 TO frame_max%
            IF scrollh%<>0 OR scrollv%<>0 THEN
              PROCcopyframe(1,frame%,hindex%,vindex%,skip%)
              hindex%+=scrollh%
              vindex%+=scrollv%
            ELSE
              PROCframesave(frame%)
            ENDIF
          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

      REM COPY A FRAME STARTING FROM OFFSET
      DEF PROCcopyframe(S%,D%,H%,V%,skip%)
      LOCAL U%,X%,Y%,xofs%,yofs%

      FOR X%=skip% TO 39
        REMIF X%>skip% THEN
        xofs%=X%+H%
        IF xofs%<0 THEN xofs%=40+xofs%
        IF xofs%>39 THEN xofs%=xofs%-40
        FOR Y%=0 TO 23
          yofs%=Y%+V%
          IF yofs%<0 THEN yofs%=23+yofs%
          IF yofs%>23 THEN yofs%=yofs%-24

          IF xofs%>skip%-1 THEN FRAME_BUFFER(D%,X%+Y%*40)=FRAME_BUFFER(S%,xofs%+yofs%*40)
        NEXT
        REM ENDIF
      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%=UNDO_MAX%

      FOR U%=0 TO 959
        UNDO_BUFFER(UNDO_INDEX%,U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT
      IF UNDO_INDEX%>0 THEN PROCdrawmenu
      ENDPROC

      REM RESTORE UNDO SCREEN
      DEF PROCundorestore
      LOCAL U%

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

        UNDO_INDEX%-=1
      ENDIF

      ENDPROC

      REM SAVE REDO SCREEN
      DEF PROCredosave
      LOCAL U%
      REDO_INDEX%+=1
      IF REDO_INDEX%>UNDO_MAX% THEN REDO_INDEX%=UNDO_MAX%

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

      ENDPROC

      REM RESTORE REDO SCREEN
      DEF PROCredorestore
      LOCAL U%

      IF REDO_INDEX%>0 THEN
        FOR U%=0 TO 959
          VDU 31,(U% MOD 40),(U% DIV 40+1),REDO_BUFFER(REDO_INDEX%,U%)
        NEXT

        REDO_INDEX%-=1
        UNDO_INDEX%+=1

      ENDIF

      ENDPROC

      REM MENU BUFFER SAVE SCREEN
      DEF PROCmenusave
      LOCAL U%
      FOR U%=0 TO 959
        MENU_BUFFER(U%)=GET(U% MOD 40,U% DIV 40+1)
      NEXT

      ENDPROC

      REM MENU BUFFER UNDO SCREEN
      DEF PROCmenurestore
      LOCAL U%

      IF menuext% THEN
        FOR U%=0 TO 959
          VDU 31,(U% MOD 40),(U% DIV 40+1),MENU_BUFFER(U%)
        NEXT
        menuext%=0
      ENDIF
      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 *.BIN", "", "", "")

      REM HACK SORT, NEED TO LOOK INTO READING FILE DATES AND SORTING NEWEST FIRST
      FOR I%=1 TO N% DIV 2
        SWAP n$(I%),n$(N%-I%+1)
      NEXT

      PROCWAITMOUSE(0)
      PROCmenusave : menuext%=99
      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

        REM DETECT FIRST TOUCH OR MOVEMENT WHEN TOUCHING
        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

        REM DETECT TOUCH RELEASE
        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

        REM IF SCROLLING DETECTED UPDATE FILE LIST AND SELECTED FILE INDEX
        IF INDEX%<>INDEXOLD% OR SELOLD%<>SEL% THEN
          FOR I%=0 TO 10
            K%=I%+INDEX%
            IF K%<N%+1 AND K%>0 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

      PROCmenurestore

      IF F%>0 THEN
        IF LEFT$(FNUPPER(n$(SEL%)),3)="M7_" THEN
          F$=LEFT$(n$(SEL%),22)
          FOR frame%=1 TO frame_max%
            PROCloadbinaryfile(F$ + STR$(frame%)+".BIN")
            PROCframesave(frame%)
            REM WAIT 10
          NEXT
          PROCloadnextframe(1,0)
        ELSE
          IF RIGHT$(FNUPPER(n$(SEL%)),3)="BIN" THEN
            PROCloadbinaryfile(n$(SEL%))
            PROCframesave(frame%)
          ENDIF
        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")
        OSCLI "SCREENSAVE ""M7_" + T$ + "_" + STR$(frame%)+".BMP"" 0,0,1280,1000"
        WAIT 10
      NEXT

      PROCloadnextframe(1,0)

      PROCmenusave : menuext%=99
      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)

      PROCmenurestore

      ENDPROC

      REM ANIMATE ALL FRAMES IN SEQUENCE FROM 1 TO FRAME_MAX%
      DEF PROCplay

      PROCframesave(frame%)
      PROCWAITMOUSE(0)

      VDU 23,1,0;0;0;0; : REM Disable cursor

      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)

      VDU 23,1,1;0;0;0; : REM Enable cursor

      ENDPROC

      REM Convert to upper case:
      DEF FNUPPER(a$) IF LENa$=0 THEN =""
      LOCAL p%%
      FOR p%% = PTR(a$) TO PTR(a$)+LENa$-1
        IF ?p%% >= 97 IF ?p%% <= 122 ?p%% -= 32
      NEXT
      = a$

      REM UPDATE COLOUR STRIP FOR BUFFER
      DEF PROCGR_BUF(D%,F%,B%)

      REM ADD GRAPHICS CODE TO LEFT SIDE OF CANVAS
      FOR Y%=0 TO 23
        IF B% THEN
          FRAME_BUFFER(D%,Y%*40)=144+B%
          FRAME_BUFFER(D%,Y%*40+1)=157
          FRAME_BUFFER(D%,Y%*40+2)=144+F%
        ELSE
          FRAME_BUFFER(D%,Y%*40)=144+F%
        ENDIF
      NEXT

      ENDPROC


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

      REM CLS
      IF C% THEN VDU 12

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

      ENDPROC

      REM PRINT PALETTE AND MENU
      DEF PROCdrawmenu
      LOCAL A%,D%,E%,R%,U%
      FOR count%=1 TO 7
        PRINTTAB(count%*2-2,0) CHR$(128+count%);CHR$(255+(count%=curcol%)*213);
      NEXT count%

      A%=135-animation%*5
      D%=dither%+1
      E%=135-erase%*5
      R%=130+(REDO_INDEX%=0)
      U%=130+(UNDO_INDEX%=0)
      PRINTTAB(14,0) CHR$(135);"PD";STR$(D%);"FS";CHR$(E%);"E";CHR$(U%);"U";CHR$(R%);"R";CHR$(135);"CBF LS";CHR$(A%);"A";CHR$(135);STR$(frame%);"<>P"

      REM SHAPE MENU
      IF menuext%=1 THEN
        D%=135-animateshape%*5

        A$="LRO"+CHR$(D%)+"A"+CHR$(134)+"GAP:"+CHR$(135)+"-"+CHR$(131)+STR$(animategap%)+CHR$(135)+"+"+CHR$(134)+"LEN:"+CHR$(135)+"-"+CHR$(131)+STR$(animatelen%)+CHR$(135)+"+"

        PRINTTAB(0,1)A$;SPC(40-LEN(A$))
      ENDIF

      REM CONTROL CODE MENU
      IF menuext%=2 THEN

        A$="136"+CHR$(136)+CHR$(255)+CHR$(137)+CHR$(154)+"154"+CHR$(151)+CHR$(255)+CHR$(153)+CHR$(135)+"158"+CHR$(158)+CHR$(255)+"  "+CHR$(131)+STR$(GET(TX%,TY%))+"  "
        B$=CHR$(132)+"FLSH   SEPR   HOLD   CODE"
        PRINTTAB(0,1)A$;SPC(40-LEN(A$))
        PRINTTAB(0,2)B$;SPC(40-LEN(B$))
      ENDIF

      ENDPROC
Last edited by FourthStone on Tue Sep 01, 2020 6:39 am, edited 1 time in total.

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

Re: Teletext paint program

Post by pixelblip » Tue Sep 01, 2020 5:48 am

Thanks Fourthstone that is brill.
I’ll have a play at lunch.

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

Re: Teletext paint program

Post by pixelblip » Tue Sep 01, 2020 6:22 am

The undo redo is simple and well worked out . Thanks.

Post Reply

Return to “programming”