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
(I'll do some anyway of course !)
