How do you save a screen

Discuss all aspects of programming here. From 8-bit through to modern architectures.
User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Wed Jun 14, 2017 2:19 am

ART for Windows now updated with more robust mouse click behavior, also added dialog for file open/save but no code to do the save and load...

Please have a play and let me know if it's working ok.

Code: Select all

      REM MODE 22 : 128x48 Chars : 1024x768 Real Pixels : 2048x1536 Logical Pixels : 16 Colours

      REM Chars are 16x32

      REM Drawing window: Mode 2 160x256 beeb pixels, 640x512 real pixels, 1280 x 1024 logical pixels

      REM Patterns 0 - 17
      DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
      DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
      DATA 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,1,0,0,1,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,1,0,0,1,0,1,0,0,0,0,1
      DATA 1,0,1,0,0,1,0,1,1,0,1,0,0,0,0,1
      DATA 1,0,1,0,0,1,0,1,1,0,1,0,0,1,0,1
      DATA 0,1,0,1,1,0,1,0,0,1,0,1,1,0,1,0
      DATA 0,1,0,1,1,0,1,0,0,1,0,1,1,1,1,0
      DATA 0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,0
      DATA 0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1
      DATA 0,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1
      DATA 0,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1
      DATA 0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1
      DATA 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
      DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1

      MODE 22
      ON ERROR OSCLI "REFRESH ON" : ON : CLS : REPORT : PRINT " at line "; ERL : VDU 7 : END

      REM Switch off cursor and switch on print to graphics cursor
      VDU 23,1,0;0;0;0;
      VDU 5

      MOUSE ON 3

      REM Pattern AND undo array
      DIM pat{(17)c(15)}
      DIM undo{(8) bmphnd%,w,h}

      DIM buf(1000)

      REM READ Pattern data
      FOR I%=0 TO 17
        FOR J%=0 TO 15
          READ pat{(I%)}.c(J%)
        NEXT
      NEXT

      REM Mouse coords
      LET mx%=0
      LET my%=0
      LET mb%=0
      LET ma%=0

      REM Pattern and colour vars
      LET col%=1
      LET pat%=8
      LET pcol%=0
      LET pS%=0

      REM Pixel coords at mouse cursor
      LET px%=0
      LET py%=0

      REM drawing vars
      LET dX%=0
      LET dY%=0
      LET dW%=1500
      LET dT%=1
      LET dC%=0

      LET fExit=FALSE

      REM Colour definitions for drawing palette
      COLOUR 1,255,0,0
      COLOUR 2,0,255,0
      COLOUR 3,255,255,0
      COLOUR 4,0,0,255
      COLOUR 5,255,0,255
      COLOUR 6,0,255,255
      COLOUR 7,255,255,255

      REM Colour definitions for tools palette
      COLOUR 9,192,0,0
      COLOUR 10,0,192,0
      COLOUR 11,192,192,0
      COLOUR 12,0,0,192
      COLOUR 13,192,0,192
      COLOUR 14,0,192,192
      COLOUR 15,192,192,192

      REM Turn off screen refresh, must use *REFRESH to update screen
      *REFRESH OFF

      GCOL 7

      REM Draw region
      RECTANGLE 0,0,1296,1044
      RECTANGLE 2,2,1292,1040

      REM palette
      RECTANGLE 0,1068,1184,396

      REM Col select
      RECTANGLE 1200,1068,64,396
      RECTANGLE 1208,col%*48+1074,46,46

      REM Current drawing pattern
      RECTANGLE 1280,1336,128,128

      REM Brush size
      RECTANGLE 1280,1068,128,204


      REM Tools
      RECTANGLE 1424,1068,616,396
      PROCbutton(1440,1412,"LOAD")
      PROCbutton(1440,1356,"SAVE")
      PROCbutton(1440,1300,"CLS")
      PROCbutton(1440,1244,"UNDO")
      PROCbutton(1896,1412,"EXIT")
      PROCbox(1440,1084,48,48)

      REM Transparency toggle
      GCOL 2
      RECTANGLE FILL 1448,1090,34,34

      FOR I%=0 TO 7
        GCOL I%
        RECTANGLE FILL 1312,200+I%*56,56,56
        GCOL I%+8
        RECTANGLE FILL 1368,200+I%*56,56,56
      NEXT

      REM Labels
      PROCdt(1200,1496,3,"Col",0)
      PROCdt(1284,1496,3,"Pat",0)
      PROCdt(1284,1304,3,"Size",0)
      PROCdt(1428,1496,3,"Tools",0)
      PROCdt(1512,1136,3,"Brush Transparancy",0)
      PROCdt(1512,1104,3,"(only works with black pixels)",0)

      REM Stats
      PROCdt(1312,1024,2,"mX:",0)
      PROCdt(1312,992,2,"mY:",0)
      PROCdt(1312,960,2,"pX:",0)
      PROCdt(1312,928,2,"pY:",0)
      PROCdt(1312,896,2,"mB:",0)
      PROCdt(1312,864,2,"sC:",0)
      PROCdt(1312,832,2,"pC:",0)
      PROCdt(1312,800,2,"pS:",0)
      PROCdt(1312,768,2,"dW:",0)


      REM Colour select and title
      FOR I%=0 TO 7
        GCOL I%
        RECTANGLE FILL 1216,I%*48+1080,32,32
        MOVE 440+I%*4,1512+I%*2
        GCOL (I% DIV 7)*2+1
        PRINT "ART For Windows!!!"
      NEXT

      REM Size guide
      GCOL 6
      CIRCLE FILL 1344,1112,30
      CIRCLE FILL 1344,1168,20
      CIRCLE FILL 1344,1212,12
      CIRCLE FILL 1344,1240,8


      PROCpalette
      PROCbrush

      REM === Main loop ===

      REPEAT
 
        REM Make sure ART window has focus
        SYS "GetForegroundWindow" TO hw%
        IF hw% = @hwnd% THEN
   
          REM check for Z and X to change draw size
          IF INKEY-98 AND dW%>0 dW%=dW%-1
          IF INKEY-67 AND dW%<3000 dW%=dW%+1
   
          PROCreadmouse
   
          REM left mouse button clicked
          IF mb%=4 THEN
     
            REM Check for mouse region
            IF mx%>0 AND mx%<1288 AND my%>4 AND my%<1032 THEN ma%=1
            IF mx%>1200 AND mx%<1264 AND my%>1076 AND my%<1452 THEN ma%=2
            IF mx%>8 AND mx%<1168 AND my%>1076 AND my%<1452 THEN ma%=3
            IF mx%>1280 AND mx%<1408 AND my%>1072 AND my%<1272 THEN ma%=4
            IF mx%>1432 AND mx%<2024 AND my%>1080 AND my%<1456 THEN ma%=5
     
            CASE ma% OF
              WHEN 1: PROCdrawing
              WHEN 2: PROCcolSelect
              WHEN 3: PROCpalSelect
              WHEN 4: PROCsizeSelect
              WHEN 5: PROCtools
            ENDCASE
     
            ma%=0
     
            REM === END OF LEFT MOUSE BUTTON SECTION ===
          ENDIF
        ENDIF
 
      UNTIL fExit

      *REFRESH ON

      QUIT

      REM === END OF MAIN PROGRAM ===

      REM === Procedures ===

      DEF PROCreadmouse
      REM read mouse status
      MOUSE mx%, my%, mb%

      REM normalise mouse coords to pixel grid
      mx%=(mx% DIV 8)*8
      my%=(my% DIV 4)*4

      REM Update stats
      PROCshowstats

      *REFRESH

      ENDPROC

      REM draw on main canvas
      DEF PROCdrawing
      REPEAT
        PROCreadmouse
 
        REM get pixel coords
        px%=(mx% DIV 8)-(dW% DIV 400)-1
        py%=(my% DIV 4)-(dW% DIV 200)-2
 
        REM draw pattern loop
        FOR lX%=0 TO (dW% DIV 200)
          FOR lY%=0 TO (dW% DIV 100)
            REM range check, set pattern colour and plot
            IF (px%+lX%)>-1 AND (px%+lX%)<160 AND (py%+lY%)>-1 AND (py%+lY%)<256 THEN
              pS%=(px%+lX%) MOD 4+((py%+lY%) MOD 4)*4
              IF pat{(pat%)}.c(pS%) THEN
                dC%=pcol%
              ELSE
                dC%=col%
              ENDIF
       
              REM Check for transparency
              IF dC%-dT%>-1 THEN
                GCOL dC%
                RECTANGLE FILL (px%+lX%)*8+8,(py%+lY%)*4+8,8,4
              ENDIF
            ENDIF
          NEXT
        NEXT
      UNTIL mb%=0
      ENDPROC

      REM Check for colour select region
      DEF PROCcolSelect
      REPEAT
        PROCreadmouse
        I%=(my%-1072) DIV 48
        IF col%<>I% AND I%>-1 AND I%<8 THEN
          GCOL 0
          RECTANGLE 1208,col%*48+1074,46,46
   
          GCOL 7
          RECTANGLE 1208,I%*48+1074,46,46
          col%=I%
          PROCpalette
          PROCbrush
        ENDIF
      UNTIL mb%=0
      ENDPROC

      REM Check for palette select region
      DEF PROCpalSelect
      REPEAT
        PROCreadmouse
 
        I%=((my%-1072) DIV 48)
        J%=((mx%-16) DIV 64)
 
        IF I%>-1 AND I%<8 AND J%>-1 AND J%<18 THEN
          IF pcol%<>I% OR pat%<>J% THEN
            GCOL 0
            RECTANGLE FILL 16+pat%*64,1072+pcol%*48,64,4
     
            pcol%=I%
            pat%=J%
            PROCbrush
          ENDIF
        ENDIF
      UNTIL mb%=0
      ENDPROC

      REM Check brush size change region
      DEF PROCsizeSelect
      REPEAT
        PROCreadmouse
 
        I%=3200-((my%-1076) DIV 6)*100
        J%=(dW% DIV 10)*10
        IF I%<>J% AND I%>-1 AND I%<3201 THEN dW%=I%
      UNTIL mb%=0
      ENDPROC

      REM Tools region
      DEF PROCtools
      REM Clear mouse button
      REPEAT
        PROCreadmouse
      UNTIL mb%=0

      REM Load, Save, CLS, Undo
      IF mx%>1432 AND mx%<1568 AND my%>1240 AND my%<1456 THEN
        tool%=(my%-1240) DIV 56
 
        PROCdt(1464,1024,3,STR$(tool%),2)
 
        CASE tool% OF
          WHEN 0 :
          WHEN 1 : GCOL 0: RECTANGLE FILL 4,4,1288,1036
          WHEN 2: PROCopensave(1)
          WHEN 3: PROCopensave(0)
          OTHERWISE
        ENDCASE
      ENDIF

      REM Transparency toggle
      IF mx%>1432 AND mx%<1488 AND my%>1080 AND my%<11132 THEN
        dT%=(dT%+1) MOD 2
 
        GCOL dT%*2
        RECTANGLE FILL 1448,1090,34,34
      ENDIF

      REM Exit button
      IF mx%>1888 AND mx%<2024 AND my%>1408 AND my%<1456 THEN
        fExit=TRUE
      ENDIF
      ENDPROC


      REM Draw box with current brush
      DEF PROCbrush

      bx%=1280
      by%=1332

      REM draw pattern loop
      FOR lX%=0 TO 13
        FOR lY%=0 TO 27
          pS%=(bx%+lX%) MOD 4+((by%+lY%) MOD 4)*4
          IF pat{(pat%)}.c(pS%) THEN
            GCOL pcol%
          ELSE
            GCOL col%
          ENDIF
          RECTANGLE FILL bx%+lX%*8+10,by%+lY%*4+12,8,4
        ENDIF
      NEXT
      NEXT

      REM highlight selected pattern
      GCOL 7
      RECTANGLE FILL 16+pat%*64,1072+pcol%*48,64,4

      ENDPROC

      REM Palette
      DEF PROCpalette

      FOR i%=0 TO 7
      FOR p%=0 TO 17
        FOR x%=0 TO 15
          IF pat{(p%)}.c(x%)=1 GCOL i% ELSE GCOL col%
          RECTANGLE FILL 16+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1080,8,4
          RECTANGLE FILL 16+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1096,8,4
          RECTANGLE FILL 48+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1080,8,4
          RECTANGLE FILL 48+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1096,8,4
        NEXT
      NEXT
      NEXT

      ENDPROC

      REM draw text at x,y, colour, <text>, length of string to delete first
      DEF PROCdt(x%,y%,c%,s$,l%)

      IF l% THEN
      GCOL 0
      RECTANGLE FILL x%,y%-32,16*l%,32
      ENDIF

      MOVE x%,y%
      GCOL c%
      PRINT s$

      ENDPROC


      REM Draw button
      DEF PROCbutton(x%,y%,s$)

      tx%=64-LEN(s$)*8

      PROCbox(x%,y%,128,42)

      MOVE x%+tx%,y%+34
      GCOL 3
      PRINT s$

      ENDPROC

      REM Draw button box
      DEF PROCbox(x%,y%,w%,h%)

      GCOL 15
      MOVE x%,y%
      DRAW x%+w%,y%
      DRAW x%+w%,y%+h%
      MOVE x%+w%-2,y%+h%-2
      DRAW x%+w%-2,y%+2
      DRAW x%+2,y%+2

      GCOL 7
      DRAW x%+2,y%+h%-2
      DRAW x%+w%-2,y%+h%-2
      MOVE x%+w%,y%+h%
      DRAW x%,y%+h%
      DRAW x%,y%

      ENDPROC

      DEF PROCopensave(a%)

      LET filename$=""
      LET operation$="GetOpenFileName"
      IF a%=1 THEN operation$="GetSaveFileName"

      DIM fs{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
      \      lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
      \      lpstrFile%, nMaxFile%, lpstrFileTitle%, \
      \      nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
      \      flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
      \      lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
      DIM fp{t&(260)}

      ff$ = "BMP files"+CHR$0+"*.BMP"+CHR$0+CHR$0
      fs.lStructSize% = DIM(fs{})
      fs.hwndOwner% = @hwnd%
      fs.lpstrFilter% = !^ff$
      fs.lpstrFile% = fp{}
      fs.nMaxFile% = 260
      fs.flags% = 6


      SYS operation$, fs{} TO result%
      IF result% filename$ = $$fp{}

      IF filename$="" THEN filename$= "Not Selected"
      PROCdt(1400,100,2,MID$(filename$,FNINSTRREV(filename$,"\")+1),20)

      REM flush mouse buffer
      REPEAT
      PROCreadmouse
      UNTIL mb%=0

      ENDPROC

      REM Show stats
      DEF PROCshowstats

      px%=(mx% DIV 8)-1
      py%=(my% DIV 4)-2

      PROCdt(1360,1024,2,STR$(mx%),4)
      PROCdt(1360,992,2,STR$(my%),4)
      PROCdt(1360,960,2,STR$(px%),4)
      PROCdt(1360,928,2,STR$(py%),4)
      PROCdt(1360,896,2,STR$(mb%),2)
      PROCdt(1360,864,2,STR$(col%),2)
      PROCdt(1360,832,2,STR$(pcol%),2)
      PROCdt(1360,800,2,STR$(pat%),2)
      PROCdt(1360,768,2,STR$(dW%),4)

      ENDPROC

      DEF FNINSTRREV(s$,f$)
      LOCAL I%
      FOR I%=LEN(s$) TO 1 STEP -1
      IF MID$(s$,I%,LEN(f$))=f$ THEN =I%
      NEXT
      =0

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Wed Jun 14, 2017 6:56 am

Cheers Fourthstone. I'll have a go today.

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Wed Jun 14, 2017 10:25 am

Just playing around with transparency, I want to see if I can repeat this with original ART.

ART4W_Sample.png

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Wed Jun 14, 2017 11:10 am

That looks so awesome!
We are surely stretching Mode 2 to it's limits. There's life yet left in the mode! =D>

If you have time to get save and load working before the weekend I'll do a piccy with it :) (I'll do some anyway of course !)

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Thu Jun 15, 2017 12:46 am

Load and Save now working, saves in BMP format only at this time.

Single undo implemented but it uses a temp file called UNDO.BMP, can't see a way to do it in memory without getting full version :-k

Let me know if the undo code causes any performance issue when drawing, I couldn't notice any slow down at all... if it works ok with the temp file I could increase the number of undos by using more temp files :wink:

Enjoy :-)

Code: Select all

      REM MODE 22 : 128x48 Chars : 1024x768 Real Pixels : 2048x1536 Logical Pixels : 16 Colours

      REM Chars are 16x32

      REM Drawing window: Mode 2 160x256 beeb pixels, 640x512 real pixels, 1280 x 1024 logical pixels

      REM Patterns 0 - 17
      DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
      DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
      DATA 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,1,0,0,1,0,1,0,0,0,0,0
      DATA 1,0,1,0,0,1,0,0,1,0,1,0,0,0,0,1
      DATA 1,0,1,0,0,1,0,1,1,0,1,0,0,0,0,1
      DATA 1,0,1,0,0,1,0,1,1,0,1,0,0,1,0,1
      DATA 0,1,0,1,1,0,1,0,0,1,0,1,1,0,1,0
      DATA 0,1,0,1,1,0,1,0,0,1,0,1,1,1,1,0
      DATA 0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,0
      DATA 0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1
      DATA 0,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1
      DATA 0,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1
      DATA 0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1
      DATA 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
      DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1

      MODE 22
      ON ERROR OSCLI "REFRESH ON" : ON : CLS : REPORT : PRINT " at line "; ERL : VDU 7 : END

      REM Switch off cursor and switch on print to graphics cursor
      VDU 23,1,0;0;0;0;
      VDU 5

      MOUSE ON 3

      REM Pattern AND undo array
      DIM pat{(17)c(15)}
      DIM undo{(8) bmphnd%,w,h}

      DIM buf(1000)

      REM READ Pattern data
      FOR I%=0 TO 17
        FOR J%=0 TO 15
          READ pat{(I%)}.c(J%)
        NEXT
      NEXT

      REM Mouse coords
      LET mx%=0
      LET my%=0
      LET mb%=0
      LET ma%=0

      REM Pattern and colour vars
      LET col%=1
      LET pat%=8
      LET pcol%=0
      LET pS%=0

      REM Pixel coords at mouse cursor
      LET px%=0
      LET py%=0

      REM drawing vars
      LET dX%=0
      LET dY%=0
      LET dW%=1500
      LET dT%=1
      LET dC%=0

      LET fExit=FALSE

      REM Colour definitions for drawing palette
      COLOUR 1,255,0,0
      COLOUR 2,0,255,0
      COLOUR 3,255,255,0
      COLOUR 4,0,0,255
      COLOUR 5,255,0,255
      COLOUR 6,0,255,255
      COLOUR 7,255,255,255

      REM Colour definitions for tools palette
      COLOUR 9,192,0,0
      COLOUR 10,0,192,0
      COLOUR 11,192,192,0
      COLOUR 12,0,0,192
      COLOUR 13,192,0,192
      COLOUR 14,0,192,192
      COLOUR 15,192,192,192

      REM Turn off screen refresh, must use *REFRESH to update screen
      *REFRESH OFF

      GCOL 7

      REM Draw region
      RECTANGLE 0,0,1296,1044
      RECTANGLE 2,2,1292,1040

      REM palette
      RECTANGLE 0,1068,1184,396

      REM Col select
      RECTANGLE 1200,1068,64,396
      RECTANGLE 1208,col%*48+1074,46,46

      REM Current drawing pattern
      RECTANGLE 1280,1336,128,128

      REM Brush size
      RECTANGLE 1280,1068,128,204


      REM Tools
      RECTANGLE 1424,1068,616,396
      PROCbutton(1440,1412,"LOAD")
      PROCbutton(1440,1356,"SAVE")
      PROCbutton(1440,1300,"CLS")
      PROCbutton(1440,1244,"UNDO")
      PROCbutton(1896,1412,"EXIT")
      PROCbox(1440,1084,48,48)

      REM Transparency toggle
      GCOL 2
      RECTANGLE FILL 1448,1090,34,34

      FOR I%=0 TO 7
        GCOL I%
        RECTANGLE FILL 1312,200+I%*56,56,56
        GCOL I%+8
        RECTANGLE FILL 1368,200+I%*56,56,56
      NEXT

      REM Labels
      PROCdt(1200,1496,3,"Col",0)
      PROCdt(1284,1496,3,"Pat",0)
      PROCdt(1284,1304,3,"Size",0)
      PROCdt(1428,1496,3,"Tools",0)
      PROCdt(1512,1136,3,"Brush Transparancy",0)
      PROCdt(1512,1104,3,"(only works with black pixels)",0)

      REM Stats
      PROCdt(1312,1024,2,"mX:",0)
      PROCdt(1312,992,2,"mY:",0)
      PROCdt(1312,960,2,"pX:",0)
      PROCdt(1312,928,2,"pY:",0)
      PROCdt(1312,896,2,"mB:",0)
      PROCdt(1312,864,2,"sC:",0)
      PROCdt(1312,832,2,"pC:",0)
      PROCdt(1312,800,2,"pS:",0)
      PROCdt(1312,768,2,"dW:",0)


      REM Colour select and title
      FOR I%=0 TO 7
        GCOL I%
        RECTANGLE FILL 1216,I%*48+1080,32,32
        MOVE 440+I%*4,1512+I%*2
        GCOL (I% DIV 7)*2+1
        PRINT "ART For Windows!!!"
      NEXT

      REM Size guide
      GCOL 6
      CIRCLE FILL 1344,1112,30
      CIRCLE FILL 1344,1168,20
      CIRCLE FILL 1344,1212,12
      CIRCLE FILL 1344,1240,8


      PROCpalette
      PROCbrush

      REM === Main loop ===

      REPEAT
 
        REM Make sure ART window has focus
        SYS "GetForegroundWindow" TO hw%
        IF hw% = @hwnd% THEN
   
          REM check for Z and X to change draw size
          IF INKEY-98 AND dW%>0 dW%=dW%-1
          IF INKEY-67 AND dW%<3000 dW%=dW%+1
   
          PROCreadmouse
   
          REM left mouse button clicked
          IF mb%=4 THEN
     
            REM Check for mouse region
            IF mx%>0 AND mx%<1288 AND my%>4 AND my%<1032 THEN ma%=1
            IF mx%>1200 AND mx%<1264 AND my%>1076 AND my%<1452 THEN ma%=2
            IF mx%>8 AND mx%<1168 AND my%>1076 AND my%<1452 THEN ma%=3
            IF mx%>1280 AND mx%<1408 AND my%>1072 AND my%<1272 THEN ma%=4
            IF mx%>1432 AND mx%<2024 AND my%>1080 AND my%<1456 THEN ma%=5
     
            CASE ma% OF
              WHEN 1: PROCdrawing
              WHEN 2: PROCcolSelect
              WHEN 3: PROCpalSelect
              WHEN 4: PROCsizeSelect
              WHEN 5: PROCtools
            ENDCASE
     
            ma%=0
     
            REM === END OF LEFT MOUSE BUTTON SECTION ===
          ENDIF
        ENDIF
 
      UNTIL fExit

      *REFRESH ON

      QUIT

      REM === END OF MAIN PROGRAM ===

      REM === Procedures ===

      DEF PROCreadmouse
      REM read mouse status
      MOUSE mx%, my%, mb%

      REM normalise mouse coords to pixel grid
      mx%=(mx% DIV 8)*8
      my%=(my% DIV 4)*4

      REM Update stats
      PROCshowstats

      *REFRESH

      ENDPROC

      REM draw on main canvas
      DEF PROCdrawing

      PROCsaveundo

      REPEAT
        PROCreadmouse
 
        REM get pixel coords
        px%=(mx% DIV 8)-(dW% DIV 400)-1
        py%=(my% DIV 4)-(dW% DIV 200)-2
 
        REM draw pattern loop
        FOR lX%=0 TO (dW% DIV 200)
          FOR lY%=0 TO (dW% DIV 100)
            REM range check, set pattern colour and plot
            IF (px%+lX%)>-1 AND (px%+lX%)<160 AND (py%+lY%)>-1 AND (py%+lY%)<256 THEN
              pS%=(px%+lX%) MOD 4+((py%+lY%) MOD 4)*4
              IF pat{(pat%)}.c(pS%) THEN
                dC%=pcol%
              ELSE
                dC%=col%
              ENDIF
       
              REM Check for transparency
              IF dC%-dT%>-1 THEN
                GCOL dC%
                RECTANGLE FILL (px%+lX%)*8+8,(py%+lY%)*4+8,8,4
              ENDIF
            ENDIF
          NEXT
        NEXT
      UNTIL mb%=0
      ENDPROC

      REM Check for colour select region
      DEF PROCcolSelect
      REPEAT
        PROCreadmouse
        I%=(my%-1072) DIV 48
        IF col%<>I% AND I%>-1 AND I%<8 THEN
          GCOL 0
          RECTANGLE 1208,col%*48+1074,46,46
   
          GCOL 7
          RECTANGLE 1208,I%*48+1074,46,46
          col%=I%
          PROCpalette
          PROCbrush
        ENDIF
      UNTIL mb%=0
      ENDPROC

      REM Check for palette select region
      DEF PROCpalSelect
      REPEAT
        PROCreadmouse
 
        I%=((my%-1072) DIV 48)
        J%=((mx%-16) DIV 64)
 
        IF I%>-1 AND I%<8 AND J%>-1 AND J%<18 THEN
          IF pcol%<>I% OR pat%<>J% THEN
            GCOL 0
            RECTANGLE FILL 16+pat%*64,1072+pcol%*48,64,4
     
            pcol%=I%
            pat%=J%
            PROCbrush
          ENDIF
        ENDIF
      UNTIL mb%=0
      ENDPROC

      REM Check brush size change region
      DEF PROCsizeSelect
      REPEAT
        PROCreadmouse
 
        I%=3200-((my%-1076) DIV 6)*100
        J%=(dW% DIV 10)*10
        IF I%<>J% AND I%>-1 AND I%<3201 THEN dW%=I%
      UNTIL mb%=0
      ENDPROC

      REM Tools region
      DEF PROCtools
      REM Clear mouse button
      REPEAT
        PROCreadmouse
      UNTIL mb%=0

      REM Load, Save, CLS, Undo
      IF mx%>1432 AND mx%<1568 AND my%>1240 AND my%<1456 THEN
        tool%=(my%-1240) DIV 56
 
        PROCdt(1464,1024,3,STR$(tool%),2)
 
        CASE tool% OF
          WHEN 0 : PROCundo
          WHEN 1 : PROCsaveundo: GCOL 0: RECTANGLE FILL 8,8,1280,1024
          WHEN 2: PROCopensave(1)
          WHEN 3: PROCopensave(0)
          OTHERWISE
        ENDCASE
      ENDIF

      REM Transparency toggle
      IF mx%>1432 AND mx%<1488 AND my%>1080 AND my%<11132 THEN
        dT%=(dT%+1) MOD 2
 
        GCOL dT%*2
        RECTANGLE FILL 1448,1090,34,34
      ENDIF

      REM Exit button
      IF mx%>1888 AND mx%<2024 AND my%>1408 AND my%<1456 THEN
        fExit=TRUE
      ENDIF
      ENDPROC

      DEF PROCsaveundo
      OSCLI "SCREENSAVE UNDO.BMP 8,8,1280,1024"
      ENDPROC

      DEF PROCundo
      OSCLI "DISPLAY UNDO.BMP 8,8,1280,1024"
      ENDPROC



      REM Draw box with current brush
      DEF PROCbrush

      bx%=1280
      by%=1332

      REM draw pattern loop
      FOR lX%=0 TO 13
        FOR lY%=0 TO 27
          pS%=(bx%+lX%) MOD 4+((by%+lY%) MOD 4)*4
          IF pat{(pat%)}.c(pS%) THEN
            GCOL pcol%
          ELSE
            GCOL col%
          ENDIF
          RECTANGLE FILL bx%+lX%*8+10,by%+lY%*4+12,8,4
        ENDIF
      NEXT
      NEXT

      REM highlight selected pattern
      GCOL 7
      RECTANGLE FILL 16+pat%*64,1072+pcol%*48,64,4

      ENDPROC

      REM Palette
      DEF PROCpalette

      FOR i%=0 TO 7
      FOR p%=0 TO 17
        FOR x%=0 TO 15
          IF pat{(p%)}.c(x%)=1 GCOL i% ELSE GCOL col%
          RECTANGLE FILL 16+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1080,8,4
          RECTANGLE FILL 16+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1096,8,4
          RECTANGLE FILL 48+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1080,8,4
          RECTANGLE FILL 48+p%*64+(x% MOD 4)*8,i%*48+(x% DIV 4)*4+1096,8,4
        NEXT
      NEXT
      NEXT

      ENDPROC

      REM draw text at x,y, colour, <text>, length of string to delete first
      DEF PROCdt(x%,y%,c%,s$,l%)

      IF l% THEN
      GCOL 0
      RECTANGLE FILL x%,y%-32,16*l%,32
      ENDIF

      MOVE x%,y%
      GCOL c%
      PRINT s$

      ENDPROC


      REM Draw button
      DEF PROCbutton(x%,y%,s$)

      tx%=64-LEN(s$)*8

      PROCbox(x%,y%,128,42)

      MOVE x%+tx%,y%+34
      GCOL 3
      PRINT s$

      ENDPROC

      REM Draw button box
      DEF PROCbox(x%,y%,w%,h%)

      GCOL 15
      MOVE x%,y%
      DRAW x%+w%,y%
      DRAW x%+w%,y%+h%
      MOVE x%+w%-2,y%+h%-2
      DRAW x%+w%-2,y%+2
      DRAW x%+2,y%+2

      GCOL 7
      DRAW x%+2,y%+h%-2
      DRAW x%+w%-2,y%+h%-2
      MOVE x%+w%,y%+h%
      DRAW x%,y%+h%
      DRAW x%,y%

      ENDPROC

      REM Open Save dialoge
      DEF PROCopensave(a%)

      LET filename$=""
      LET action$=""
      LET operation$="GetOpenFileName"
      IF a%=1 THEN operation$="GetSaveFileName"

      DIM fs{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
      \      lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
      \      lpstrFile%, nMaxFile%, lpstrFileTitle%, \
      \      nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
      \      flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
      \      lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
      DIM fp{t&(260)}

      ff$ = "BMP files"+CHR$0+"*.BMP"+CHR$0+CHR$0
      fs.lStructSize% = DIM(fs{})
      fs.hwndOwner% = @hwnd%
      fs.lpstrFilter% = !^ff$
      fs.lpstrFile% = fp{}
      fs.nMaxFile% = 260
      fs.flags% = 6


      SYS operation$, fs{} TO result%
      IF result% filename$ = $$fp{}

      IF filename$="" THEN
      filename$= "File Not Selected!"
      ELSE
      CASE a% OF
        WHEN 0:action$="opened":OSCLI "DISPLAY """+filename$+""" 8,8,1280,1024"
        WHEN 1:action$="saved":OSCLI "SCREENSAVE """ + filename$ + """ 8,8,1280,1024"
      ENDCASE
      ENDIF

      PROCdt(1312,736,2,MID$(filename$,FNINSTRREV(filename$,"\")+1) + " " + action$,60)

      REM flush mouse buffer
      REPEAT
        PROCreadmouse
      UNTIL mb%=0

      ENDPROC

      REM Show stats
      DEF PROCshowstats

      px%=(mx% DIV 8)-1
      py%=(my% DIV 4)-2

      PROCdt(1360,1024,2,STR$(mx%),4)
      PROCdt(1360,992,2,STR$(my%),4)
      PROCdt(1360,960,2,STR$(px%),4)
      PROCdt(1360,928,2,STR$(py%),4)
      PROCdt(1360,896,2,STR$(mb%),2)
      PROCdt(1360,864,2,STR$(col%),2)
      PROCdt(1360,832,2,STR$(pcol%),2)
      PROCdt(1360,800,2,STR$(pat%),2)
      PROCdt(1360,768,2,STR$(dW%),4)

      ENDPROC

      DEF FNINSTRREV(s$,f$)
      LOCAL I%
      FOR I%=LEN(s$) TO 1 STEP -1
        IF MID$(s$,I%,LEN(f$))=f$ THEN =I%
      NEXT
      =0

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Thu Jun 15, 2017 3:56 am

Thank you Fourthstone. I think you deserve some time away from Art now.
Well done. Have a nice weekend if I don't speak to you before then. It's great you have Undo and save done now.

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Fri Jun 16, 2017 9:36 pm

Garden of Illion
Attachments
9cc fin.jpg

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sat Jun 17, 2017 6:28 am

The Temple of Zarius
Attachments
c9h.jpg

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sat Jun 17, 2017 10:39 am

Encounter
Attachments
Encoubtee.jpg

User avatar
hoglet
Posts: 6390
Joined: Sat Oct 13, 2012 6:21 pm
Location: Bristol

Re: How do you save a screen

Postby hoglet » Sat Jun 17, 2017 10:52 am

Fantastic!

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sat Jun 17, 2017 11:20 am

Thanks hoglet!

User avatar
SimonSideburns
Posts: 251
Joined: Mon Aug 26, 2013 8:09 pm
Location: Purbrook, Hampshire
Contact:

Re: How do you save a screen

Postby SimonSideburns » Sat Jun 17, 2017 2:00 pm

Great pictures yet again.

Has anyone taken these screenshots and created discs of them so we can watch a slideshow? That would be even more impressive.

Would give me something to try on my new Beeb with a CUB monitor.
I'm writing a game where you can change your character from a Wizard to a monkey to a cat.

Well, Imogen that!

User avatar
aerworuld
Posts: 1684
Joined: Tue Sep 25, 2012 8:40 pm
Location: Basingstoke, Hampshire
Contact:

Re: How do you save a screen

Postby aerworuld » Sat Jun 17, 2017 3:43 pm

Then, once the slideshow is released, put it on Demozoo 8)

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Sun Jun 18, 2017 4:54 am

Very impressive!

A slideshow disk would be fantastic [-o<

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sun Jun 18, 2017 6:28 am

Transmission
Attachments
ufo7.jpg

User avatar
tricky
Posts: 1823
Joined: Tue Jun 21, 2011 8:25 am
Contact:

Re: How do you save a screen

Postby tricky » Sun Jun 18, 2017 7:08 am

I love all of your creations, but want to play the adventure game that goes with them :)

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sun Jun 18, 2017 7:37 am

Yes see what you mean : :lol:

I seem to be fixated with alien planets at the moment!

User avatar
Pablos544
Posts: 282
Joined: Tue Jul 15, 2014 4:25 pm
Location: London, UK

Re: How do you save a screen

Postby Pablos544 » Sun Jun 18, 2017 3:26 pm

tricky wrote:I love all of your creations, but want to play the adventure game that goes with them :)


I was just thinking that as well? :lol:

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sun Jun 18, 2017 4:40 pm

So these pictures were done with the new version of Art.
It's nice to use........I like painting in 8 colours....it's so much easier than say trying to do some art in Photoshop.

When you are feeling up for doing a bit more- it would be nice to be able to use a spray brush in it ( with flow control ) - I guess that could do as a sort of opaque tool.......that could be very nice.......

I think you got the interface right....it's simple and effective. It might be nice to see a pre-defined set of brush sizes so you can pick one ( sometimes it's a bit hit and miss finding the right size ).....but no matter it works ok. The Transparency thing is very good......it has made a big difference.........especially for those UFO laser pick me up beams :lol:

I am sure you have more planned up your sleeve.
It's very easy to read the program in BBC Basic.....and to think it's relatively so small but does so much!

I'll do some more pictures next weekend. I'll try after work but like all of us - I need to veg out after a long day at work....it can be quite hard to do a painting after work. Still it's working well now and it's not bad on my Atom tablet at all....thank you :)

I am quite tempted to try and covert some of my paintings to Speccy format just to see what they would be like...if I do I'll post some just for fun.

User avatar
SimonSideburns
Posts: 251
Joined: Mon Aug 26, 2013 8:09 pm
Location: Purbrook, Hampshire
Contact:

Re: How do you save a screen

Postby SimonSideburns » Sun Jun 18, 2017 9:31 pm

I wonder if it is at all possible to change the name of the original post in this thread.

Every time I see it I fail to make the connection between what the post has become to how the original query started out.

Simon
I'm writing a game where you can change your character from a Wizard to a monkey to a cat.

Well, Imogen that!

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Mon Jun 19, 2017 8:52 am

I'm happy for the mods to change this post name if they wish.......as it's always evolving

User avatar
Elminster
Posts: 1632
Joined: Wed Jun 20, 2012 8:09 am
Location: Essex, UK

Re: How do you save a screen

Postby Elminster » Mon Jun 19, 2017 8:56 am

Or just kick off a new, or a couple of new threads.

i.e. Picture Thread
Art software thread (maybe one for BBC BASIC V SDL and one for BBC BASIC 2

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Mon Jun 19, 2017 10:29 am

I think a thread (or two, or a git) for ART would make sense, and... I really think a whole (new) channel could be devoted to Retro artwork.

Starting a new job this week so will try to find time on the weekend for some further dev work on ART for BB4W, I've noticed a bug with undo and loading images where a half width line of pixels is left at the top of the drawing frame... nothing major but will have a look at it.

Really keen to see a speccy version of your artwork Pixelblip [-o<

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Tue Jun 20, 2017 9:12 am

ZX images look suprisingly good considering the limitations

I will start a few new threads this week ok......sorry just wanted you all to see this.
Attachments
4.jpg
(70.45 KiB) Not downloaded yet
3.jpg
(68.2 KiB) Not downloaded yet
2.jpg
(69.14 KiB) Not downloaded yet
1.jpg
(54.17 KiB) Not downloaded yet

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Tue Jun 20, 2017 9:53 am

pixelblip wrote:ZX images look suprisingly good considering the limitations


They look great!

Although... your beeb versions are superior =D>

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Wed Jun 21, 2017 9:07 am

I've started a new Art Thread just for piccies - Acorn Archy and Beeb/Electron.
I'd like to post speccy images from time to time but being an Acorn site it's not really fair so I will post them on a speccy site and let you know.
Here's the Art picture thread:

viewtopic.php?f=11&t=13294

User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sat Jun 24, 2017 6:15 pm

I've posted a pic up to the new thread :)
viewtopic.php?f=11&t=13294#p173692

They all seem to have some kind of weird theme to them. Maybe get another done tonight. We shall see where inspiration strikes at 4 in the morning :lol: Wouldn't it be great to be retired I keep thinking!

I just re-read your earlier post Fourthstone. It would be great to see Transparency in the original version of ART.
Some day I will move over to a real Master to carry on painting!

I've had a chance to put Art V2 through it's paces. I encourage everyone to have a go! It's really fun. You need to download the demo of BBC Basic for windows.

For some reason the program is crashing out every now and then with an error pointing to line 0 - ( something like Unidentified Error at Line 0). Fortunately a backup is made so it's still ok with UNDO as a filename but I am trying to replicate when this happens....

I can think of a few suggestions now as I've been using it..

1) Some custom brush sizes (that you can pick from) would be good as well as an airbrush (so we could fake opacity)
2) Sometimes I wanted to go down lower than the lowest dither.....I don't know whether that's possible.....it can contain quite a few dots still.........but it's not a big deal
3) Drawing a polygon then having it automatically flood fill into that shape could be useful ( as well as a flood fill )
4) Line Drawing would be cool as well.....
5) An Undo History with back n forward


Well food for thought. It's great I am using it on all these devices which are ancient and it's working well. Of course if you are at the 32k limit then maybe leave it the way it is!

Flashing colours would also be a brill thing to try. In terms of creating animations.....I can imagine twinkling stars in these pics......by using palette cycling.
Some of my fav memories are BBC animated mode 2 pics.....it's amazing what you can do with just that simple effect. :)

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Sun Jun 25, 2017 1:20 am

Hey Pixel,

Loving the retro art thread, really awesome work happening there.

I've started redoing some of ART for BB4W to make it into a more procedural application so I can easily make the changes we've discussed, however I've hit a bit of a bug or programming snag that I need to clarify with the developer around how rectangles are filled because to me it doesn't seem to work as it should... this is critical to ensuring that the patterns being drawn are the correct dimension and scale.

I've made a small demonstration program to illustrate this issue, basically when drawing a rectangle outline and filling the same region the program produces different sized blocks... which also explains why there is a line of pixels left behind when loading, undoing and a cls... the rectangle fill seems to use a slightly different coord and width height params than rectangle which is strange so I just need to clarify if this is correct or have it explained to me how it works so I can program art correctly... phew, I think that's it :lol:

Anyway, have a look if you like and if anyone else has any comments or advice about why BB4W behaves this way I'd love to hear your thoughts.

Code: Select all

      MODE 22


      REM fill doesn't appear to work?
      GCOL 3

      REM Large outline
      RECTANGLE 8,8,1280,1024

      REM small outline
      RECTANGLE 8,1100,64,64


      GCOL 1

      REM Large fill
      RECTANGLE FILL 8,8,1280,1024

      REM small fill
      RECTANGLE FILL 8,1100,64,64


      a=GET

      REM coords for fill have to be stretched out to appear to work?
      REM y has to start 2 pixels lower and finish 2 pixels higher
      REM x has to finish 2 pixels wider

      GCOL 3
      REM Large outline
      RECTANGLE 8,8,1280,1024

      REM small outline
      RECTANGLE 8,1100,64,64


      GCOL 1
      REM Large file
      RECTANGLE FILL 8,6,1282,1026

      REM small fill
      RECTANGLE FILL 8,1098,66,66


User avatar
pixelblip
Posts: 426
Joined: Wed Feb 04, 2015 7:19 pm

Re: How do you save a screen

Postby pixelblip » Sun Jun 25, 2017 5:16 am

I've run that but I'm not sure what you mean as I just see two rectangles.........maybe it's better to wait until the developer gets back to save you having to explain this again....

User avatar
FourthStone
Posts: 387
Joined: Thu Nov 17, 2016 2:29 am
Location: Melbourne, Australia

Re: How do you save a screen

Postby FourthStone » Sun Jun 25, 2017 6:19 am

Hey Pixel, when you run the sample program, did you see a yellow border around part of the red boxes like below? On my screen there is still yellow border left behind on bottom and right side borders... strange if you don't get it as well might just be my display?

BB4W_FillAnomaly.jpg


Return to “programming”

Who is online

Users browsing this forum: No registered users and 2 guests