Planet Creator

Discuss all aspects of programming here. From 8-bit through to modern architectures.
Post Reply
User avatar
pixelblip
Posts: 1373
Joined: Wed Feb 04, 2015 7:19 pm
Location: London
Contact:

Planet Creator

Post by pixelblip » Sun Oct 06, 2019 7:33 pm

Hi everyone
I am going to give this to everyone as a thank you to the Acorn Universe!
This is like the Oscars..here is my speech! ..I want to thank Fourthstone for everything he has done! He has been amazing. We have been chipping away at this for years. This is what I like about the internet. If it wasn't for the internet he wouldn't have contacted me and said wow Mike I like that picture can I help you e.t.c - in fact everyone here has been so helpful.

There were some other people at the start who also helped me trying to move the mouse and click on buttons......in the programming thread...you remember those heady days when I first tried to move the cursor and plot a shape with the almighty Graphics Extension Rom! They were little steps up the big mountain and I can say I am looking down to the coloured worlds from above now!

We will continue to develop this awesome art software......

This is the first time I've done some proper programming. As I am an artist first and a messy person second so whatever you do don't look at the code! It's really awful (mine) and cobbled together so don't expect to understand it. Sorry! I just had to get it out the door.

This is the Planet creator program written in BBC Basic for windows ( paid verison) . Save it into the ART4WINDOWS folder in windows (https://github.com/marsFS/ART-4-Windows) - you need Richard Russell's excellent BBC basic to run it as it is quite large.
That is another thing about BBC Basic. It is the best language ever invented! I am not a programmer by any means but it allowed me to get somewhere. How many languages let you do that eh? They should start teaching it again in schools. I can't get python or VB but I can understand this.....so that is my little preachy bit out of the way!

Maybe one day I can get this program working on a the Beeb and the graphics extension rom.... It would be cool but a real challenge to get into 12k in mode 2.

This program generates far off planets and just saves them to disk automatically. Let's see some from you!

I might take a break soon from pictures as I start to wrestle with Music 5000 and algorithmic music. So watch this space! I want to get the computer to make ambient soundtracks to the pictures. We shall see! I've got this far with things so why not!

Anyway again - thank you Fourthstone. We have travelled the BBC universe together and are still going forward to more unexplored worlds!
Enjoy!
Mike


REM ART for Windows, written by FourthStone 2017
REM Planet creator written by Pixelblip 2019

REM Custom mode to suite portrait tablet device
REM 752x920 Real Pixels : 1504x1840 Logical Pixels
REM 94x57 Chars : 16x32 logical pixels
REM 16 Colours (reversed standard palette)
REM VDU 23,22,752;920;8,16,16,0

HIMEM = (LOMEM+4000000) AND -4

VDU 23,22,1024;768;8,16,16,0

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

REM Switch off cursor, switch on print to graphics cursor, configure mouse pointer
VDU 23,1,0;0;0;0;
VDU 5
MOUSE ON 3

DIM beebPal%(15)

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

REM Pattern, mouse area, buttons and undo array, Fill Stack
maCount%=7
bCount%=0
maxUndo%=20
DIM pat{(17) c%(15)}
DIM M{(maCount%) bx%,by%,bw%,bh%,mx%,my%,mx2%,my2%}
DIM MI(maCount%)
DIM TB{(bCount%) mx%,my%,mx2%,my2%}
DIM FS% 40959

REM Start drawing!

REPEAT
rep%=0

PROCinitART
qS%=1 : REM sets quick save on

PROCdrawscene

PROCopensave(1,"ART_QS_") : REM a number will be added e.g. ART_QS_00000.BMP
CLS
UNTIL rep%=1

REM ============================
REM === Main Drawing Section ===
REM ============================

REM Canvas is 0..159 x 0..255 with 0,0 being lower left corner

REM Pattern and colour vars
REM col% - primary pattern colour (0..7)
REM pcol% - pattern second colour (0..7)
REM pat% - pattern number (0..17)

REM drawing vars
REM dw% - draw brush width
REM dT% - draw transparent flag (0..1)

REM Hot Tip - *REFRESH to see things drawn during a loop!

REM col%=1 : REM red
REM PROCdBrush(10,10,10,0) : REM standard brush: X , Y , DrawWidth, BrushType 0=standard

REM col%=2 : REM Green
REM pcol%=4 : REM Blue
REM PROCdBrush(30,10,10,1) : REM standard X2 brush: X , Y , DrawWidth, BrushType 1=x2

REM col%=3 : REM Yellow
REM pcol%=0 : REM Black
REM FOR x=50 TO 100
REM PROCdBrush(x,10,10,2) : REM airbrush: X , Y , DrawWidth, BrushType 2=airbrush
REM NEXT

REM col%=4 : REM blue
REM PROCdCircle(120,20,20) : REM circle brush: X , Y , Radius

REM col%=5 : REM Magenta
REM dw%=5
REM PROCdLine(159,0,120,128) : REM line X1,Y1 to X2,Y2

REM col%=6 : REM Cyan
REM pat%=9 : REM Change pattern number so we can see transparency working
REM PROCdCircOut(120,128,50) : REM circle outline X , Y, Radius


REM col%=1 : REM Red
REM pcol%=3 : REM Yellow
REM pat%=0
REM dT%=0 : REM no transparency i.e. overwrite
REM FOR x=100 TO 10 STEP -10
REM PROCdCircle(20,220,x)
REM pat%=pat%+1
REM *REFRESH
REM NEXT

REM col%=7
REM pcol%=4
REM PROCdrawBoxG(80,255,159,200,0) : REM draw gradient box X1 , Y1 , X2 , Y2 , Direction 0=horizontal, 1=vertical
REM PROCdrawBoxG(0,128,20,40,1) : REM draw gradient box X1 , Y1 , X2 , Y2 , Direction 0=horizontal, 1=vertical



REM dT%=0

REM col%=1
REMpcol%=4
REMpat%=4
REMdT%=0
REMPROCdrawBox(30,128,80,40,1) : REM draw box X1 , Y1 , X2 , Y2 , Fill 0=no fill, 1=fill


REMcol%=5
REMpcol%=3
REM PROCfloodFill(40,60) : REM flood fill area X , Y


REM ===============================
REM === Drawing done, press any key
REM ===============================


REM === Finalise and exit

CLS
*REFRESH ON
VDU 4








REM draw scene

DEF PROCdrawscene

PROCdrawsky

PROCdrawplanet

PROCdrawstars
PROCsun
REM PROCdrawclouds
REM drawmountains
PROCdrawtowers1
PROCdrawtowers2

PROCdrawcity
PROCdrawfog


REM PROCopensave(1)

ENDPROC


DEF PROCdrawtowers2
dw%=1
col%=16
pat%=12
pcol%=8

FOR notowers%=1 TO RND(6)
towerheight%=RND(70)/2
towergap%=RND(4)
towerxpos%=RND(256)
FOR girders%=1 TO RND(4)
col%=16
pat%=12
dw%=1
randh%=towerheight%+RND(100)
PROCdLine(towerxpos%,0, towerxpos%,randh%)


col%=7
dw%=1
IF sunxpos%<80 PROCdLine(towerxpos%-dw%,0, towerxpos%-dw%,randh%)
IF sunxpos%>80 PROCdLine(towerxpos%+dw%,0, towerxpos%+dw%,randh%)
towerxpos%=towerxpos%+ towergap%
step%=RND(8)
FOR light%=1 TO randh% STEP step%
col%=0
pat%=1
pcol%=8
PROCdCircle(towerxpos%,light%,4)
NEXT light%

col%=8
dice%=RND(1)
IF dice%=1 col%=2:pcol%=2:pat%=1:PROCdBrush(towerxpos%-dw%*dw%,randh%,8,1)
pcol%=0
pat%=12
NEXT girders%
NEXT notowers%
ENDPROC

DEF PROCdrawsky
skygrad1%=RND(7)
skygrad2%=RND(7)
skygrad3%=RND(7)
skygrad4%=RND(7)
col%=skygrad1%
pcol%= skygrad2%
PROCdrawBoxG(0,0,256,24,1)

col%=skygrad2%
pcol%= skygrad3%
PROCdrawBoxG(0,24,256,72,1)

col%=skygrad3%
pcol%= skygrad4%
PROCdrawBoxG(0,72,256,148,1)

col%=skygrad4%
pcol%= 0
PROCdrawBoxG(0,148,256,256,1)
ENDPROC

DEF PROCdrawtowers1
col%=0
dT%=1
pcol%=16
pat%=8
FOR loop%=1 TO RND(8)+5
x1%=RND(640)
xw%=RND(25)
twy%=RND(200)
towermidcount%=xw%

ty%=0
dw%=1
step%=RND(20)
minus%=xw%
middletower%=x1%+xw%/2
PROCdLine(x1%,ty%,x1%+xw%/2,twy%)
PROCdLine(x1%+xw%,ty%,x1%+xw%/2,twy%)
NEXT loop%






ENDPROC




DEF PROCdrawclouds
band1%=2
band2%=8
band3%=64
band4%=128


dT%=1
col%=7
pcol%=0
pat%=12
starty%=0
val%=20
x%=0
y%=1
gap%=5
thick%=1
width%=1
wval%=10
y%=1
x%=0
count%=1
gap%=1
rand%=5
col%=7
pcol%=0
band%=band1%
step%=1.2
rnd%=RND(4)
col%=RND(7)
extray%=1
pat%=8
dT%=1
tick%=1
pcol%=0

REPEAT


PROCdrawBoxG(x%,y%,x%+RND(rand%/1)/1.2+RND(8*count%)+tick%,y%+count%*rand%/32*8.9+band%/4,1)
IF y%>1 AND y%<32 band%=band1%:extray%=2
IF y%>32 band%=band2% :extray%=12
IF y%>64 band%=band3%:extray%=24
IF y%>128 band%=band4%:extray%=48
num%=RND(2)
IF num%=1 y%=y%+RND(10)
IF num%=2 y%=y%-RND(10)
rnd%=RND(4)
tick%=tick%+1.1



x%=x%+RND(32)+count%*20
IF x%>256 x%=RND(10):y%=y%+rand%/count%/2+band%/count%/2/4+step%*20+extray%/2:count%=count%+0.5/1.5:gap%=gap%+RND(5)*9+tick%*4:rand%=rand%+RND(3)*2.2:step%=step%*1.2:

*REFRESH

UNTIL y%>256






ENDPROC



REM Drawplanet

DEF PROCdrawplanet
weight%=RND(20)
incol%=RND(7)
FOR starsam%=1 TO RND(60)+50
dT%=1

col%=incol%
pat%=16
starxpos%=RND(640)
starypos%=RND(512)


FOR x=RND(50) TO 0 STEP -4

PROCdCircle(starxpos%,starypos%,x-(x/60))
pat%=pat%-1
IF pat%<0 pat%=16


*REFRESH
NEXT x
REM col%=RND(7)
pat%=16

PROCdCircle(starxpos%,starypos%,5)


NEXT starsam%




weight%=RND(5)
*REFRESH


incol%=RND(7)
weight%=1

dT%=1
incol%=RND(7)
col%=incol%
pat%=8
starxpos%=RND(128)
starypos%=RND(256)
val%=RND(80)+20
col%=7
pat%=8
dT%=1
PROCdCircle(starxpos%-2,starypos%+2,val%)
pat%=8
dT%=1
col%=RND(7)
PROCdCircle(starxpos%-2,starypos%+2,val%)
dT%=1
col%=RND(7)
pat%=8
patcol%=0

PROCdCircle(starxpos%,starypos%,val%)




pcol%=0
pat%=pat%-1


REM PROCdCircle(starxpos%,starypos%,5)







weight%=RND(5)


*REFRESH


ENDPROC


DEF PROCsun
pcol%=RND(7)
rnd%=RND(2)
pcol%=0
REM IF rnd%=1 col%=3 ELSE col%=7
col%=RND(7)
sidecol%=col%
dT%=1


pat%=16
sunxpos%=RND(160)
sunypos%=RND(128)


FOR x=RND(20)+50 TO 1 STEP -4

PROCdCircle(sunxpos%,sunypos%,x)
pat%=pat%-1
IF pat%<0 pat%=16


*REFRESH
NEXT x

ENDPROC


REM Drawstars

DEF PROCdrawstars
weight%=RND(20)
REM col%=RND(7)
FOR num%=1 TO RND(8)
incol%=RND(7)

FOR starsam%=1 TO RND(10)
dT%=1


pat%=16
starxpos%=RND(640)
starypos%=RND(512)


FOR x=RND(30) TO 0 STEP -4

PROCdCircle(starxpos%,starypos%,RND(5))
pat%=pat%-1
IF pat%<0 pat%=16


*REFRESH
NEXT x
REM col%=RND(7)
pat%=16

PROCdCircle(starxpos%,starypos%,RND(5))

*REFRESH
NEXT starsam%
REM col%=RND(7)
NEXT num%




weight%=RND(20)
FOR num%=1 TO RND(16)
incol%=RND(7)
FOR starsam%=1 TO RND(10)+20
dT%=1

REM col%=RND(7)
pat%=1
starxpos%=RND(640)
starypos%=RND(512)




PROCdCircle(starxpos%,starypos%,2)


REM
pat%=16



*REFRESH
NEXT starsam%
REM col%=RND(7)
NEXT num%




weight%=RND(5)

ENDPROC

DEF PROCdrawcity
gapy%=RND(20)
weighty%=0.4
dT%=1
pcol%=0
pat%=0
FOR layer%=5TO 1 STEP -1
REM pat%=0

by%=0
bx%=0
dT%=1


col%=RND(7)
rem%=col%
pcol%=16
FOR nobuildingsperlayer%=1 TO RND(20)
REM dT%=0

REM pcol%=1
col%=RND(7)
buildingwidth%=RND(8)*nobuildingsperlayer%/4
gap%=RND(buildingwidth%)*8

buildingheight%=RND(5+nobuildingsperlayer%)*weighty%
IF layer%=5 dT%=1:pcol%=0
IF layer%=4 dT%=1:pcol%=0
IF layer%<3 dT%=0:pcol%=0

IF buildingheight%<10 buildingheight%=RND(200)/layer%
IF gap%<1 gap%=RND(buildingwidth%)*8
PROCdrawBoxG(bx%,by%,bx%+buildingwidth%,by%+buildingheight%,1)
col%=sidecol%
pcol%=sidecol%

IF sunxpos%>80 PROCdrawBoxG(bx%+buildingwidth%,by%,bx%+buildingwidth%,by%+buildingheight%,1)
IF sunxpos%<80 PROCdrawBoxG(bx%,by%,bx%,by%+buildingheight%,1)
REM PROCdrawBoxG(bx%,by%+buildingheight%,bx%+buildingwidth%,by%+buildingheight%,1)

col%=rem%
PROCwindows(buildingwidth%, buildingheight%,bx%,by%)




col%=rem%
rempat%=pat%
col%=0
REM pat%=1
rand%=RND(2)
middle%=bx%+buildingwidth%/2
pat%=16
pcol%=RND(7)
PROCdrawBoxG(middle%,by%+buildingheight%,middle%,by%+buildingheight%+RND(buildingheight%*1.1),1)
col%=rem%
pat%=rempat%
pat%=pat%-1

bx%=bx%+buildingwidth%+gap%

*REFRESH

NEXT nobuildingsperlayer%
by%=0


weighty%= weighty%+2
IF layer%<2 dT%=0:pcol%=0

*REFRESH

pcol%=pcol%-1
NEXT layer%


ENDPROC







DEF PROCwindows(buildingwidth%, buildingheight%,bx%,by%)
dT%=0
REM col%=RND(7)
pat%=0
pcol%=0
rem%=col%
windwidth%=buildingwidth%/8
nooffloors%=RND(4)+4
middleline%=bx%+(buildingwidth%/2)


FOR count%=1 TO nooffloors%-1
windowchance%=RND(3)
IF windowchance%=1 col%=RND(7)


floorheight%=(buildingheight%/nooffloors%)*(count%)
dw%=1
REM loorheight%=buildingheight%/nooffloors%*count%
IF floorheight%<1 floorheight%=1
IF windowchance%=1 PROCdrawBox(middleline%-windwidth%/4,floorheight%,middleline%+(windwidth%/4),floorheight%+windwidth%/4 ,1)
REM PROCdrawBox(middleline%,floorheight%,middleline% ,floorheight%+windwidth%,1)
REM PROCdLine(middleline%,floorheight%,middleline%,floorheight%+windwidth%)
REM PROCdrawBox(middleline%-windwidth%/2,floorheight%,middleline%+(windwidth%/2),floorheight%+windwidth%/2 ,1)
PROCdrawBox(middleline%-windwidth%/2,floorheight%,middleline%+(windwidth%/2),floorheight%+windwidth%/2 ,1)
p%=RND(4)
IF windowchance%=1 PROClight
REM IF p%=1 dT%=1: PROCdrawBox(middleline%-windwidth%/2,floorheight%,middleline%+(windwidth%/2),floorheight%+windwidth%/2*2 ,1)

*REFRESH

NEXT count%
ENDPROC

ENDPROC

DEF PROClight
remcol%=col%
rempat%=pat%
rempcol%=pcol%


pcol%=0
pat%=11
remdt%=dT%
dT%=1
PROCdCircle(middleline%-windwidth%/2+windwidth%/2,floorheight%+windwidth%,RND(6)+3)
pcol%=rempcol%
pat%=rempat%
col%=remcol%
dT%=remdt%


ENDPROC


DEF PROCdrawmountains
dw%=1
dT%=1

FOR layer%=1 TO 4
light%=RND(2)
dT%=1
mxright%=0
col%=RND(7)
pat%=12

FOR mountain%=1 TO RND(mountain%*2)


height%=RND(60)+50/layer%

myground%=0
myheight%=myground%+height%
mxwidth%=RND(60)
width%=mxwidth%
FOR count%=1 TO mxwidth%*2
PROCdLine(mxright%,myground%,mxright%+mxwidth%,myheight%)
mxwidth%= mxwidth%-1
IF mxwidth%<0 mxwdith%=0
mxright%=mxright%+1

NEXT count%


NEXT mountain%
pat%=pat%-4
IF pat%=0 pat%=16

NEXT layer%
ENDPROC



DEF PROCdrawfog





height%=RND(3)
dT%=1
pat%=9
pcol%=0
y%=0
col%=RND(7)
FOR count%=1 TO 5


pcol%=0
PROCdrawBox(0,y%,640,4*count%*2,1)
y%=(y%+count%*2)+height%/2
pat%=pat%+1
REM A$=GET$


NEXT count%
ENDPROC

















REM ===========================
REM === END OF MAIN PROGRAM ===
REM ===========================


REM *-----------------------*
REM ====== Functions ======

REM ### find position of f$ in s$ starting at last char
DEF FNINSTRREV(s$,f$)
LOCAL i%
IF LEN(s$)>0 THEN
FOR i%=LEN(s$) TO 1 STEP -1
IF MID$(s$,i%,LEN(f$))=f$ THEN =i%
NEXT
ENDIF
=0

REM ### return true if mouse position is in a defined mouse area
DEF FNmRange(i%)
IF mx%>=M{(i%)}.mx% AND mx%<=M{(i%)}.mx2% AND my%>=M{(i%)}.my% AND my%<=M{(i%)}.my2% THEN =TRUE
=FALSE

REM ### set pixel coords for relative to draw window
DEF FNpx(x%)=(x%-M{(0)}.mx%) DIV 8
DEF FNpy(y%)=(y%-M{(0)}.my%) DIV 4

REM file exists
DEF FNcheckfile(file$)
LOCAL f%
f% = OPENIN(file$)
IF f% CLOSE #f%
= f%


REM *------------------------*
REM ====== Procedures ======

REM ### read mouse status
DEF PROCreadmouse

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 ### left mouse click, check for mouse region and jump to required proc
DEF PROCleftClick
LOCAL i%, ma%
REM
FOR i%=0 TO maCount%
IF FNmRange(i%) THEN ma%=i%+1: EXIT FOR
NEXT

CASE ma% OF
WHEN 1: PROCdrawing
WHEN 2: PROCcolSelect
WHEN 3: PROCpalSelect
WHEN 4: PROCbrushSize
WHEN 5: PROCtools
WHEN 7: PROCtoolSelect
ENDCASE

ENDPROC

REM ### Tools Select region
DEF PROCtoolSelect
REM Clear mouse button
REPEAT
PROCreadmouse
UNTIL mb%=0

REM make sure we're still in tools select area
IF FNmRange(6) THEN

LOCAL tool%

REM get button of tool clicked and action
tool%=(mx%-M{(6)}.mx%) DIV 100+((M{(6)}.my2%-my%) DIV 100)*2

IF tool%>-1 AND tool%<28 THEN
CASE tool% OF
WHEN 0 : PROCopensave(1) : REM save
WHEN 1 : PROCopensave(0) : REM load
WHEN 2 : PROCundo(1) : REM redo
WHEN 3 : REMPROCundo(1) : REM redo
WHEN 19 : PROCsaveundo: PROCaFill(0,4,4,-8,-8,0) : REM CLS
WHEN 18 : dT%=(dT%+1) MOD 2: PROCtoolToggle(tool%,dT%*2)
WHEN 20,21,22,23,24 : REM brush style
IF tool%<>dS% THEN
PROCtoolToggle(dS%,0)
dS%=tool%
PROCtoolToggle(dS%,6)
ENDIF
WHEN 27 : qS%=(qS%+1) MOD 2: PROCtoolToggle(tool%,qS%*2)

OTHERWISE
IF tool%<>cT% THEN
PROCtoolToggle(cT%,0)
cT%=tool%
PROCtoolToggle(cT%,tC%)
ENDIF

ENDCASE

PROCdt(M{(4)}.bx%+60,M{(4)}.by%+68,2,STR$(tool%),4)
PROCdt(M{(4)}.bx%+268,M{(4)}.by%+68,2,STR$(cT%),4)
ENDIF
ENDIF
ENDPROC

REM ### toggle box control status
DEF PROCtoolToggle(i%,c%)
LOCAL x%,y%,lx%,ly%
IF c%=0 THEN c%=7
GCOL c%
REMRECTANGLE M{(6)}.mx%+(i% MOD 2)*100,M{(6)}.my2%-(i% DIV 2)*100-96,98,98
REMRECTANGLE M{(6)}.mx%+(i% MOD 2)*100+2,M{(6)}.my2%-(i% DIV 2)*100-94,94,94
x%=M{(6)}.mx%+(i% MOD 2)*100
y%=M{(6)}.my2%-(i% DIV 2)*100-96

FOR lx%=x% TO x%+98 STEP 2
FOR ly%=y% TO y%+98 STEP 2
IF POINT(lx%,ly%) THEN LINE lx%,ly%,lx%,ly%
NEXT
NEXT

REM alternate highlight using xor colour
REM GCOL 3,3
REM FOR ly%=y% TO y%+98 STEP 2
REM LINE x%,ly%,x%+98,ly%
REM NEXT


ENDPROC

REM ### draw on main canvas
DEF PROCdrawing
LOCAL sx%,sy%,ox%,oy%

sx%=mx%
sy%=my%
ox%=mx%
oy%=my%

PROCsaveundo

REPEAT
PROCreadmouse

CASE cT% OF
WHEN 4:
CASE dS% OF
WHEN 20 : PROCdBrush(FNpx(mx%),FNpy(my%),dw%,0) : REM standard brush
WHEN 21 : PROCdCircle(mx%,my%,dw%*4) : REM circle brush
WHEN 23 : PROCdBrush(FNpx(mx%),FNpy(my%),dw%,2) : REM airbrush
WHEN 24 : PROCdBrush(FNpx(mx%),FNpy(my%),dw%,1) : REM standard X2 brush
ENDCASE

WHEN 5: REM line
GCOL 3,7
LINE sx%,sy%,ox%,oy%
LINE sx%,sy%,mx%,my%
ox%=mx%
oy%=my%

WHEN 6,7: REM polygon filled
GCOL 3,7
CIRCLE sx%,sy%,sx%-ox%
CIRCLE sx%,sy%,sx%-mx%
ox%=mx%
oy%=my%

WHEN 8,9,12,13: REM boxes, gradient
GCOL 3,7
RECTANGLE sx%,sy%,ox%-sx%,oy%-sy%
RECTANGLE sx%,sy%,mx%-sx%,my%-sy%
ox%=mx%
oy%=my%

WHEN 10: REM flood fill
i%=POINT(mx%,my%)
IF i%<>fC% THEN
fC%=i%
PROCaFill(7,8,6,-14,-14,fC%)
ENDIF
ENDCASE

UNTIL mb%=0

GCOL 3,7

CASE cT% OF
WHEN 5: REM line draw finalisation
LINE sx%,sy%,ox%,oy%
LINE sx%,sy%,sx%,sy%

PROCdLine(sx%,sy%,mx%,my%)

WHEN 6,7: REM polygon finalisation
CIRCLE sx%,sy%,sx%-ox%

IF cT%=6 PROCdCircOut(sx%,sy%,sx%-ox%)
IF cT%=7 PROCdCircle(sx%,sy%,sx%-ox%)

WHEN 12,13: REM Gradient
RECTANGLE sx%,sy%,ox%-sx%,oy%-sy%
IF sx%<>ox% AND sy%<>oy% PROCdrawBoxG(sx%,sy%,ox%,oy%,cT%-12)

WHEN 8,9: REM boxes
RECTANGLE sx%,sy%,ox%-sx%,oy%-sy%
PROCdrawBox(sx%,sy%,ox%,oy%,cT%-8)

WHEN 10: REM flood fill
PROCfloodFill(mx%,my%)
ENDCASE

ENDPROC

REM ### drawing brush - generic routine
DEF PROCdBrush(dx%,dy%,w%,d%)
LOCAL lx%,ly%,dc%,s%,p%

CASE d% OF
WHEN 1 : REM x2 brush
dx%=((dx%-w% DIV 2) DIV 2)*2
dy%=((dy%-w%) DIV 2)*2
s%=2

OTHERWISE : REM standard brush
dx%=dx%-w% DIV 2
dy%=dy%-w%
s%=1
ENDCASE

REM draw pattern loop centered at pixel location dx,dy
FOR lx%=dx% TO dx%+w% STEP s%
FOR ly%=dy% TO dy%+w%*2 STEP s%
REM check for airbrush randomization before plotting
p%=1
IF d%=2 IF RND(1000)>5 THEN p%=0
IF p% THEN
REM range check, set pattern colour and plot
IF lx%>-1 AND lx%<160 AND ly%>-1 AND ly%<256 THEN
CASE d% OF
WHEN 1 : REM x2 brush
pS%=(lx% DIV 2) MOD 4+((ly% DIV 2) MOD 4)*4
OTHERWISE
pS%=lx% MOD 4+(ly% MOD 4)*4
ENDCASE
IF pat{(pat%)}.c%(pS%) THEN
dc%=pcol%
ELSE
dc%=col%
ENDIF

REM Check for transparency
IF dc%-dT%>-1 OR (pat{(pat%)}.c%(pS%)=1 AND col%=0) THEN
GCOL dc%

RECTANGLE FILL lx%*8+M{(0)}.mx%,ly%*4+M{(0)}.my%-2,8,4

REM FB%?(lx%+ly%*160)=dc%
ENDIF
ENDIF
ENDIF
NEXT
NEXT

ENDPROC

REM ### line drawing brush
DEF PROCdLine(x1%,y1%,x2%,y2%)

LOCAL dx%,dy%,sx%,sy%
LOCAL e2,err

REM get pixel coords for line
REM x1%=FNpx(x1%) : y1%=FNpy(y1%)
REM x2%=FNpx(x2%) : y2%=FNpy(y2%)

REM determine which vector to use for err
dx%=ABS(x2%-x1%)
dy%=ABS(y2%-y1%)
IF x1%<x2% THEN sx%=1 ELSE sx%=-1
IF y1%<y2% THEN sy%=1 ELSE sy%=-1
err=dx%-dy%

REM Draw starting segment
PROCdBrush(x1%,y1%,dw%,0)

REM draw line loop
REPEAT
IF x1%=x2% AND y1%=y2% THEN EXIT REPEAT
e2=2*err
IF e2>-dy% THEN
err=err-dy%
x1%=x1%+sx%
PROCVline2(x1%+(dw% DIV 2)*sx%,y1%-dw%,y1%+dw%)
ENDIF
IF e2<dx% THEN
err=err+dx%
y1%=y1%+sy%
PROCHline2(x1%-(dw% DIV 2),x1%+(dw% DIV 2),y1%+dw%*sy%)
ENDIF
IF x1%<-dw% OR x1%>160+dw% THEN EXIT REPEAT
IF y1%<-dw% OR y1%>256+dw% THEN EXIT REPEAT
PROCreadmouse
UNTIL 0

ENDPROC

REM ### draw vertical line with current pattern
DEF PROCVline2(x1%,y1%,y2%)
LOCAL ly%,dc%

FOR ly%=y1% TO y2%
REM range check, set pattern colour and plot
IF x1%>-1 AND x1%<160 AND ly%>-1 AND ly%<256 THEN
pS%=x1% MOD 4+(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 x1%*8+M{(0)}.mx%,ly%*4+M{(0)}.my%-2,8,4
REM FB%?(x1%+ly%*160)=dc%
ENDIF
ENDIF
NEXT

ENDPROC

REM ### draw vertical line with current pattern
DEF PROCHline2(x1%,x2%,y1%)
LOCAL lx%,dc%

FOR lx%=x1% TO x2%
REM range check, set pattern colour and plot
IF lx%>-1 AND lx%<160 AND y1%>-1 AND y1%<256 THEN
pS%=lx% MOD 4+(y1% 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 lx%*8+M{(0)}.mx%,y1%*4+M{(0)}.my%-2,8,4
REM FB%?(lx%+y1%*160)=dc%
ENDIF
ENDIF
NEXT

ENDPROC

REM ### box draw
DEF PROCdrawBox(x1%,y1%,x2%,y2%,f%)
REM x1%=FNpx(x1%) : y1%=FNpy(y1%)
REM x2%=FNpx(x2%) : y2%=FNpy(y2%)

LOCAL t%,lx%,ly%

IF x1%>x2% THEN t%=x1%:x1%=x2%:x2%=t%
IF y1%>y2% THEN t%=y1%:y1%=y2%:y2%=t%

IF f% THEN
FOR lx%=x1%-(dw% DIV 2) TO x2%+(dw% DIV 2)
PROCVline2(lx%,y1%-dw%,y2%+dw%)
NEXT
ELSE
FOR lx%=-(dw% DIV 2) TO (dw% DIV 2)
PROCVline2(lx%+x1%,y1%-dw%,y2%+dw%)
PROCVline2(lx%+x2%,y1%-dw%,y2%+dw%)
NEXT
FOR ly%=-dw% TO dw%
PROCHline2(x1%-(dw% DIV 2),x2%+(dw% DIV 2),ly%+y1%)
PROCHline2(x1%-(dw% DIV 2),x2%+(dw% DIV 2),ly%+y2%)
NEXT
ENDIF

ENDPROC

REM ### box draw gradient, d%=0 horizontal, d%=1 vertical
DEF PROCdrawBoxG(x1%,y1%,x2%,y2%,d%)
REM x1%=FNpx(x1%) : y1%=FNpy(y1%)
REM x2%=FNpx(x2%) : y2%=FNpy(y2%)

LOCAL lx%,ly%,dc%,gR,gRd,gAdd,dv%,t%

REM Calculate direction vector, gradient value and gradient default values
dv%=1 : gR=0 : gRd=0
IF x1%>x2% THEN
SWAP x1%,x2%
IF d%=0 dv%=-1
ENDIF
IF y1%>y2% THEN
PROCupdateStatus("y1:"+STR$y1%+" y2:"+STR$y2%)
SWAP y1%,y2%
IF d%=1 dv%=-1
ENDIF
IF dv%=-1 THEN gR=17.9: gRd=17.9

IF d%=1 THEN
t%=y2%-y1%
IF t%=0 THEN t%=1
gAdd=18/t%*dv%
ELSE
t%=x2%-x1%
IF t%=0 THEN t%=1
gAdd=18/t%*dv%
ENDIF

FOR lx%=x1% TO x2%
IF d% THEN gR=gRd
FOR ly%=y1% TO y2%
REM range check, set pattern colour and plot
IF lx%>-1 AND lx%<160 AND ly%>-1 AND ly%<256 THEN
pS%=lx% MOD 4+(ly% MOD 4)*4
IF pat{(INT(gR))}.c%(pS%) THEN
dc%=pcol%
ELSE
dc%=col%
ENDIF

REM Check for transparency
IF dc%-dT%>-1 THEN
GCOL dc%
RECTANGLE FILL lx%*8+M{(0)}.mx%,ly%*4+M{(0)}.my%-2,8,4
REM FB%?(lx%+ly%*160)=dc%
ENDIF
ENDIF
IF d%=1 THEN
gR+=gAdd
IF gR>17.9 gR=17.9
IF gR<0 THEN gR=0
ENDIF

NEXT
IF d%=0 THEN
gR+=gAdd
IF gR>17.9 THEN gR=17.8
IF gR<0 THEN gR=0
ENDIF

REM*REFRESH
NEXT

ENDPROC

REM ### circle Outline drawing brush
DEF PROCdCircOut(x1%,y1%,r%)
x1%=x1%*8+8
y1%=y1%*4+464
r%=r%*4

LOCAL t%
r%=ABS(r%)

FOR t%=0 TO 359
REM PROCdStandard(FNpx(x1%+r%*COSRADt%),FNpy(INT(y1%-r%*SINRADt%)))
CASE dS% OF
WHEN 21 : PROCdCircle(x1%+r%*COSRADt%,y1%-r%*SINRADt%,dw%*4) : REM circle brush
WHEN 23 : PROCdBrush(FNpx(INT(x1%+r%*COSRADt%)),FNpy(INT(y1%-r%*SINRADt%)),dw%,2) : REM airbrush
WHEN 24 : PROCdBrush(FNpx(INT(x1%+r%*COSRADt%)),FNpy(INT(y1%-r%*SINRADt%)),dw%,1) : REM standard X2 brush

OTHERWISE
PROCdBrush(FNpx(INT(x1%+r%*COSRADt%)),FNpy(INT(y1%-r%*SINRADt%)),dw%,0)
ENDCASE

*REFRESH

NEXT
ENDPROC

REM ### circle drawing brush
DEF PROCdCircle(x1%,y1%,r%)

x1%=x1%*8+8
y1%=y1%*4+464
r%=r%*4

LOCAL r2,dy

r%=ABS(r%)
r2=r%*r%

FOR x%=r% TO 0 STEP -8
dy=SQR(r2-x%*x%)
PROCVline1(x1%-x%,INT(y1%-dy),INT(y1%+dy))
PROCVline1(x1%+x%,INT(y1%-dy),INT(y1%+dy))
REM PROCreadmouse
NEXT
ENDPROC

REM ### draw vertical line with current pattern
DEF PROCVline1(x1%,y1%,y2%)
LOCAL ly%,dc%
x1%=FNpx(x1%)
y1%=FNpy(y1%)
y2%=FNpy(y2%)

FOR ly%=y1% TO y2%
REM range check, set pattern colour and plot
IF x1%>-1 AND x1%<160 AND ly%>-1 AND ly%<256 THEN
pS%=x1% MOD 4+(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 x1%*8+M{(0)}.mx%,ly%*4+M{(0)}.my%-2,8,4
REM FB%?(x1%+ly%*160)=dc%
ENDIF
ENDIF
NEXT

ENDPROC

REM ### flood fill with current pattern
DEF PROCfloodFill(sx%,sy%)

REM sx%=FNpx(sx%)
REM sy%=FNpy(sy%)
IF (sx%)>-1 AND (sx%)<160 AND (sy%)>-1 AND (sy%)<256 THEN

LOCAL uf%,df%,c%,x%,y%,mc%,dc%,i%,fp% : REM fill,F$

uf%=0
df%=0
fp%=0
mc%=fC%

REM create stack file
REM F$=@dir$+"FILL.TMP"
REM fill=OPENOUT F$
REM IF fill<>0 THEN

REM first iteration fills with mask colour (15) to replace fill colour
REM second iteration replaces mask colour with current pattern
FOR i%=0 TO 1

REM fill with mask colour first
REM BPUT#fill,sx%: BPUT#fill,sy%
FS%?fp%=sx% : FS%?(fp%+1)=sy% : fp%+=2

REPEAT
REM get next fill point from fill list
REM PTR#fill=PTR#fill-2
REM x%=BGET#fill: y%=BGET#fill
REM PTR#fill=PTR#fill-2
fp%-=2 : x%=FS%?fp% : y%=FS%?(fp%+1)

IF POINT(x%*8+M{(0)}.mx%,y%*4+M{(0)}.my%)=mc% THEN

uf%=1 : df%=1

REM scan left
WHILE x%>0 AND POINT((x%-1)*8+M{(0)}.mx%,y%*4+M{(0)}.my%)=mc%
x%-=1
ENDWHILE

REM scan right
WHILE x%<160 AND POINT(x%*8+M{(0)}.mx%,y%*4+M{(0)}.my%)=mc%
IF i%=0 THEN
dc%=15
ELSE
pS%=x% MOD 4+(y% MOD 4)*4
IF pat{(pat%)}.c%(pS%) THEN
dc%=pcol%
ELSE
dc%=col%
ENDIF
ENDIF

GCOL dc%
RECTANGLE FILL x%*8+M{(0)}.mx%,y%*4+M{(0)}.my%-2,8,4
REM FB%?(x%+y%*160)=dc%

REM detect colour changes above and add to list
IF y%<255 THEN
c%=POINT(x%*8+M{(0)}.mx%,(y%+1)*4+M{(0)}.my%)
IF uf% AND c%=mc% THEN FS%?fp%=x% : FS%?(fp%+1)=y%+1 : fp%+=2: uf%=0
IF c%<>mc% THEN uf%=1
ENDIF

REM detect colour changes below and add to list
IF y%>0 THEN
c%=POINT(x%*8+M{(0)}.mx%,(y%-1)*4+M{(0)}.my%)
IF df% AND c%=mc% THEN FS%?fp%=x% : FS%?(fp%+1)=y%-1 : fp%+=2: df%=0
IF c%<>mc% THEN df%=1
ENDIF
x%+=1
ENDWHILE
ENDIF

*REFRESH

UNTIL fp%=0
mc%=15
NEXT

REMCLOSE#0
REM OSCLI "DEL """+F$+""""
PROCupdateStatus("INFO: Fill operation completed")
REMELSE
REM PROCupdateStatus("ERROR: Stack file could not be created")
REMENDIF
ELSE
PROCupdateStatus("INFO: Fill area must be inside drawing area")
ENDIF

ENDPROC

REM ### Check for colour select region
DEF PROCcolSelect
REPEAT
PROCreadmouse
i%=(my%-M{(1)}.my%+8) DIV 48
IF col%<>i% AND i%>-1 AND i%<8 THEN
PROCdrawColSel(col%,0)
PROCdrawColSel(i%,7)
col%=i%
PROCpalette
PROCbrush
ENDIF
UNTIL mb%=0
ENDPROC

DEF PROCdrawColSel(i%,c%)
GCOL c%
RECTANGLE M{(1)}.bx%+12,i%*48+M{(1)}.by%+6,70,46
ENDPROC

REM ### Check for palette select region
DEF PROCpalSelect
LOCAL i%,j%
REPEAT
PROCreadmouse

i%=((my%-M{(2)}.my%+8) DIV 48)
j%=((mx%-M{(2)}.mx%) DIV 64)
IF i%<0 THEN i%=0
IF i%>7 THEN i%=7
IF j%<0 THEN j%=0
IF j%>17 THEN j%=17
REM IF i%>-1 AND i%<8 AND J%>-1 AND J%<18 THEN
IF pcol%<>i% OR pat%<>j% THEN
GCOL 0
RECTANGLE FILL M{(2)}.mx%+pat%*64,M{(2)}.my%-8+pcol%*48,64,4

pcol%=i%
pat%=j%
PROCbrush
REM ENDIF
ENDIF
UNTIL mb%=0
ENDPROC

REM ### Check brush size change region
DEF PROCbrushSize
REPEAT
PROCreadmouse

s%=32-(my%-M{(3)}.my%-4) DIV 8
IF s%<>dw% AND s%>-1 AND s%<33 THEN

REM update brush size indicator
FOR i%=0 TO 1
GCOL i%*7
CIRCLE FILL M{(3)}.bx%+12,M{(3)}.by%+(32-dw%)*8+8,10
CIRCLE FILL M{(3)}.bx%+118,M{(3)}.by%+(32-dw%)*8+8,10
dw%=s%
NEXT

PROCdBrushSize
ENDIF
UNTIL mb%=0
ENDPROC

REM ### Draw brush size
DEF PROCdBrushSize

LOCAL b%,lx%,ly%

REM get pixel coords
px%=((M{(3)}.bx%+276) DIV 8)-dw% DIV 2-1
py%=((M{(3)}.by%+136) DIV 4)-dw%-1

GCOL 0
RECTANGLE FILL M{(3)}.bx%+136,M{(3)}.by%+6,264,260

b%=0

REM draw pattern loop
FOR lx%=0 TO dw%
FOR ly%=0 TO dw%*2
pS%=(px%+lx%) MOD 4+((py%+ly%) MOD 4)*4
IF pat{(pat%)}.c%(pS%) THEN
GCOL pcol%
IF pcol%<>0 THEN b%=1
ELSE
GCOL col%
IF col%<>0 THEN b%=1
ENDIF
RECTANGLE FILL (px%+lx%)*8,(py%+ly%)*4+2,8,4
NEXT
NEXT
IF b%=0 THEN
GCOL 8
RECTANGLE px%*8,py%*4+4,dw%*8+6,dw%*8+2
ENDIF
ENDPROC

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

REM make sure we're still in tools area
IF FNmRange(4) THEN
LOCAL tool%

REM scan button array for range match
FOR i%=0 TO bCount%
IF mx%>=TB{(i%)}.mx% AND mx%<=TB{(i%)}.mx2% AND my%>=TB{(i%)}.my% AND my%<=TB{(i%)}.my2% THEN tool%=i%+1: EXIT FOR
NEXT

PROCdt(M{(4)}.bx%+60,M{(4)}.by%+68,2,STR$(tool%),4)

CASE tool% OF
OTHERWISE
ENDCASE
ENDIF
ENDPROC


REM ### create mouse area coords
DEF PROCsetMouseArea(i%,x%,y%,w%,h%,mx1%,my1%,mx2%,my2%)
M{(i%)}.bx%=x% : M{(i%)}.by%=y%
M{(i%)}.bw%=w% : M{(i%)}.bh%=h%
M{(i%)}.mx%=x%+mx1% : M{(i%)}.my%=y%+my1%
M{(i%)}.mx2%=(x%+w%)+mx2% : M{(i%)}.my2%=(y%+h%)+my2%
ENDPROC

REM ### Draw box with current brush
DEF PROCbrush
LOCAL lx%,ly%

bx%=M{(5)}.bx%
by%=M{(5)}.by%-4

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
NEXT
NEXT

REM highlight selected pattern
GCOL 7
RECTANGLE FILL M{(2)}.mx%+pat%*64,M{(2)}.my%-8+pcol%*48,64,4

PROCdBrushSize

ENDPROC

REM ### Palette
DEF PROCpalette
LOCAL i%,p%,x%

FOR i%=0 TO 7
FOR p%=0 TO 17
FOR x%=0 TO 15
IF pat{(p%)}.c%(x%)=1 THEN
GCOL i%
ELSE
IF i%=0 AND col%=0 THEN
GCOL 8
ELSE
GCOL col%
ENDIF
ENDIF
RECTANGLE FILL M{(2)}.mx%+p%*64+(x% MOD 4)*8,M{(2)}.my%+i%*48+(x% DIV 4)*4,8,4
RECTANGLE FILL M{(2)}.mx%+p%*64+(x% MOD 4)*8,M{(2)}.my%+16+i%*48+(x% DIV 4)*4,8,4
RECTANGLE FILL M{(2)}.mx%+32+p%*64+(x% MOD 4)*8,M{(2)}.my%+i%*48+(x% DIV 4)*4,8,4
RECTANGLE FILL M{(2)}.mx%+32+p%*64+(x% MOD 4)*8,M{(2)}.my%+16+i%*48+(x% DIV 4)*4,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 mouse area heading
DEF PROCMdt(i%,s$)
MOVE M{(i%)}.bx%+4,M{(i%)}.by%+M{(i%)}.bh%+32
GCOL 3
PRINT s$
ENDPROC

REM ### Area Rectangle - draw rectangle relative to area coords
DEF PROCaRec(i%,rx%,ry%,rw%,rh%)
GCOL 7
RECTANGLE M{(i%)}.bx%+rx%,M{(i%)}.by%+ry%,M{(i%)}.bw%+rw%,M{(i%)}.bh%+rh%
ENDPROC

REM ### Area Rectangle Fill - fill rectangle relative to area coords
DEF PROCaFill(i%,rx%,ry%,rw%,rh%,c%)
GCOL c%
RECTANGLE FILL M{(i%)}.bx%+rx%,M{(i%)}.by%+ry%,M{(i%)}.bw%+rw%,M{(i%)}.bh%+rh%

ENDPROC

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

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

PROCtBox(i%,x%,y%,128,42)

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

ENDPROC

REM ### Draw button box
DEF PROCtBox(i%,x%,y%,w%,h%)

GCOL 8
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%

REM toolbox range check dimensions
TB{(i%)}.mx%=x%
TB{(i%)}.my%=y%
TB{(i%)}.mx2%=x%+w%
TB{(i%)}.my2%=y%+h%

ENDPROC

REM ### Open Save dialoge
DEF PROCopensave(a%,quicksave$)
LOCAL lastFN$, filename$, action$, F$, ff$, N%, hbitmap%

IF qS%=0 THEN
REM normal file/save with dialog
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: REM +"PNG files"+CHR$0+"*.PNG"+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{}

ELSE
REM Quick save file finder
lastFN$=@dir$+quicksave$

N%=0
F$=""
REPEAT
F$=lastFN$+RIGHT$("0000"+STR$(N%),5)+".BMP"
IF FNcheckfile(F$)=0 THEN
filename$=F$
ELSE
N%+=1
ENDIF
UNTIL filename$<>"" OR N%>99999
IF N%>99999 THEN PROCupdateStatus("ERROR: Cannot quicksave! File number limit reached, archive some files!!!"): ENDPROC
ENDIF

IF filename$="" THEN
filename$= "File Not Selected!"
ELSE
CASE a% OF
WHEN 0:action$="opened":OSCLI "DISPLAY """+filename$+""" "+STR$(M{(0)}.mx%)+","+STR$(M{(0)}.my%)+",1280,1024"
WHEN 1
action$="saved"
OSCLI "SCREENSAVE """ + filename$ + """ "+STR$(M{(0)}.mx%)+","+STR$(M{(0)}.my%)+",1280,1024"
REMSYS "LoadImage", 0, filename$, 0, 0, 0, 16 TO hbitmap%
REMPROCsavepng(hbitmap%, LEFT$(filename$,LEN(filename$)-3)+"png")
REMSYS "DeleteObject", hbitmap%
REMOSCLI "DEL """+filename$+""""
ENDCASE
ENDIF

PROCupdateStatus(MID$(filename$,FNINSTRREV(filename$,"\")+1) + " " + action$)


REM flush mouse buffer
REPEAT
PROCreadmouse
UNTIL mb%=0

ENDPROC

REM ### create undo file
DEF PROCsaveundo
LOCAL F$
F$=@dir$+"UNDO"+RIGHT$("0"+STR$(uC%),2)+".BMP"
OSCLI "SCREENSAVE """+F$+""" "+STR$(M{(0)}.mx%)+","+STR$(M{(0)}.my%)+",1280,1024"
REM FOR i%=0 TO 40959
REM UB%?(uC%*40960+i%)=FB%?i%
REM NEXT

REM update undo counter
uC%+=1
IF uC%>maxUndo% THEN uC%=0

ENDPROC

REM ### restore picture from undo file
DEF PROCundo(d%)
LOCAL F$
uC%-=d%
IF uC%<0 THEN uC%=maxUndo%
IF uC%>maxUndo% THEN uC%=0

F$=@dir$+"UNDO"+RIGHT$("0"+STR$(uC%),2)+".BMP"
IF FNcheckfile(F$) THEN
OSCLI "DISPLAY """+F$+""" "+STR$(M{(0)}.mx%)+","+STR$(M{(0)}.my%)+",1280,1024"
PROCupdateStatus("Success - Undo: """+F$+"""")
ELSE
PROCupdateStatus("Error - Undo: """+F$+"""")
ENDIF
ENDPROC



REM ### Update status area
DEF PROCupdateStatus(s$)
PROCdt(8,40,3,s$,80)
ENDPROC

REM ### save png file
DEF PROCsavepng(hbitmap%, filename$)
LOCAL gdiplus%, ole32%

SYS "LoadLibrary", "GDIPLUS.DLL" TO gdiplus%
IF gdiplus% = 0 PROCupdateStatus("ERROR: Couldn't load GDIPLUS.DLL"):ENDPROC
SYS "GetProcAddress", gdiplus%, "GdiplusStartup" TO `GdiplusStartup`
SYS "GetProcAddress", gdiplus%, "GdiplusShutdown" TO `GdiplusShutdown`
SYS "GetProcAddress", gdiplus%, "GdipCreateBitmapFromHBITMAP" TO `GdipCreateBitmapFromHBITMAP`
SYS "GetProcAddress", gdiplus%, "GdipDisposeImage" TO `GdipDisposeImage`
SYS "GetProcAddress", gdiplus%, "GdipSaveImageToFile" TO `GdipSaveImageToFile`
SYS "LoadLibrary", "OLE32.DLL" TO ole32%
SYS "GetProcAddress", ole32%, "CLSIDFromString" TO `CLSIDFromString`

LOCAL tSI{}, lRes%, lGDIP%, lBitmap%, tPngEncoder%, guid%, filename%

DIM tPngEncoder% LOCAL 15, guid% LOCAL 79, filename% LOCAL 2*LEN(filename$)+1
DIM tSI{GdiplusVersion%, DebugEventCallback%, \
\ SuppressBackgroundThread%, SuppressExternalCodecs%}

REM Initialize GDI+
tSI.GdiplusVersion% = 1
SYS `GdiplusStartup`, ^lGDIP%, tSI{}, 0 TO lRes%
IF lRes% PROCupdateStatus("ERROR GDI+ error "+STR$(lRes%)):ENDPROC

REM Create the GDI+ bitmap from the image handle
SYS `GdipCreateBitmapFromHBITMAP`, hbitmap%, 0, ^lBitmap% TO lRes%
IF lRes% PROCupdateStatus("ERROR: GDI+ error "+STR$(lRes%))

REM Initialize the encoder GUID
SYS "MultiByteToWideChar", 0, 0, "{557CF406-1A04-11D3-9A73-0000F81EF32E}", -1, guid%, 40
SYS `CLSIDFromString`, guid%, tPngEncoder%

REM Save the image
SYS "MultiByteToWideChar", 0, 0, filename$, -1, filename%, LEN(filename$)+1
SYS `GdipSaveImageToFile`, lBitmap%, filename%, tPngEncoder%, 0 TO lRes%
IF lRes% PROCupdateStatus("ERROR GDI+ error "+STR$(lRes%))

REM Destroy the bitmap
SYS `GdipDisposeImage`, lBitmap%

REM Shutdown GDI+
SYS `GdiplusShutdown`, lGDIP%
SYS "FreeLibrary", gdiplus%

ENDPROC

REM ### Show stats
DEF PROCshowstats

px%=FNpx(mx%)
py%=FNpy(my%)

PROCdt(M{(4)}.bx%+60,M{(4)}.by%+260,2,STR$(mx%),4)
PROCdt(M{(4)}.bx%+268,M{(4)}.by%+260,2,STR$(my%),4)
PROCdt(M{(4)}.bx%+60,M{(4)}.by%+228,2,STR$(px%),4)
PROCdt(M{(4)}.bx%+268,M{(4)}.by%+228,2,STR$(py%),4)
PROCdt(M{(4)}.bx%+60,M{(4)}.by%+196,2,STR$(mb%),2)
PROCdt(M{(4)}.bx%+60,M{(4)}.by%+164,2,STR$(col%),2)
PROCdt(M{(4)}.bx%+268,M{(4)}.by%+164,2,STR$(pcol%),2)
PROCdt(M{(4)}.bx%+60,M{(4)}.by%+132,2,STR$(pat%),2)
PROCdt(M{(4)}.bx%+60,M{(4)}.by%+100,2,STR$(dw%),4)
ENDPROC

REM ### initialize screen
DEF PROCinitART

LOCAL a%,b%,c%,d%,e%,f%,g%,h%,i%,r%


RESTORE

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

REM Colour definitions for palette
beebPal%(0) = 0
FOR i%=1 TO 15
READ r%,g%,b%
COLOUR i%,r%,g%,b%
beebPal%(i%) = b% + (g% << 8) + (r% << 16)
NEXT

REM Define mouse area lookup
FOR i%=0 TO maCount%
READ a%,b%,c%,d%,e%,f%,g%,h%
PROCsetMouseArea(i%,a%,b%,c%,d%,e%,f%,g%,h%)
NEXT

REM Mouse and pixel coords
mx%=0
my%=0
mb%=0
px%=0
py%=0

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

REM drawing vars
dw%=16 : REM draw brush width
dT%=1 : REM draw transparent flag
dS%=20 : REM draw style selected button number
cT%=4 : REM current drawing tool
fC%=0 : REM fill colour
uC%=0 : REM undo counter
tC%=3 : REM tool toggle colour
qS%=0 : REM quick save toggle

fExit=FALSE

REM Title
FOR i%=0 TO 7
MOVE 520+i%*4,1824+i%*2
GCOL (i% DIV 7)*2+1
PRINT "ART For Windows!!!"
NEXT

REM Mouse Area 0 - drawing region, double width border
PROCaRec(0,0,0,0,0)
PROCaRec(0,2,2,-4,-4)

REM Mouse Area 1 - colour select
PROCaRec(1,0,0,0,0)
PROCdrawColSel(col%,7)
FOR i%=1 TO 7
GCOL i%
RECTANGLE FILL M{(1)}.mx%+12,M{(1)}.my%+i%*48,56,32
NEXT

REM Mouse Area 2 - palette area
PROCaRec(2,0,0,0,0)

REM Mouse Area 3 - Brush size
PROCaRec(3,0,0,0,0)
GCOL 6
CIRCLE FILL M{(3)}.bx%+64,M{(3)}.by%+40,30
CIRCLE FILL M{(3)}.bx%+64,M{(3)}.by%+104,22
CIRCLE FILL M{(3)}.bx%+64,M{(3)}.by%+154,18
CIRCLE FILL M{(3)}.bx%+64,M{(3)}.by%+194,12
CIRCLE FILL M{(3)}.bx%+64,M{(3)}.by%+224,8
GCOL 8
MOVE M{(3)}.bx%+128,M{(3)}.my%+12
DRAW M{(3)}.bx%+128,M{(3)}.my2%-12
GCOL 7
CIRCLE FILL M{(3)}.bx%+12,M{(3)}.by%+(32-dw%)*8+8,10
CIRCLE FILL M{(3)}.bx%+118,M{(3)}.by%+(32-dw%)*8+8,10

REM Mouse Area 4 - Tools
PROCaRec(4,0,0,0,0)

REM Mouse Area 5 - Current drawing pattern
PROCaRec(5,0,0,0,0)

REM Mouse Area 4 - Stats
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+260,2,"mX:",0)
PROCdt(M{(4)}.bx%+220,M{(4)}.by%+260,2,"mY:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+228,2,"pX:",0)
PROCdt(M{(4)}.bx%+220,M{(4)}.by%+228,2,"pY:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+196,2,"mB:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+164,2,"sC:",0)
PROCdt(M{(4)}.bx%+220,M{(4)}.by%+164,2,"pC:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+132,2,"pS:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+100,2,"dW:",0)
PROCdt(M{(4)}.bx%+12,M{(4)}.by%+68,2,"bT:",0)
PROCdt(M{(4)}.bx%+220,M{(4)}.by%+68,2,"cT:",0)


REM Mouse Area 6 - tool select area
OSCLI "DISPLAY """+@dir$+"TOOLSTRIP.BMP"" "+STR$(M{(6)}.mx%)+","+STR$(M{(6)}.my%)
PROCtoolToggle(cT%,tC%) : REM standard
PROCtoolToggle(18,2) : REM transparency
PROCtoolToggle(dS%,6) : REM draw style


REM Mouse Area 7 - flood fill colour
PROCaRec(7,0,0,0,0)

REM Initialise palette and current brush
PROCpalette
PROCbrush


ENDPROC

REM Patterns 0 - 17, format: 4x4 grid
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

REM palette data
DATA 255,000,000,000,255,000,255,255,000,000,000,255,255,000,255
DATA 000,255,255,255,255,255,128,128,128,192,000,000,000,192,000
DATA 192,192,000,000,000,192,192,000,192,000,192,192,192,192,192

REM mouse area data: drawing, colour select, palette select, brush size select, tools, selected pattern, stats, tool select, fill colour
REM format: bounding box x, y, w, h, mx left offset, my left offset, mx right offset, my right offset
DATA 0,464,1294,1038,8,8,-6,-6
DATA 1200,52,94,396,8,12,-8,-16
DATA 0,52,1184,396,16,12,-24,-16
DATA 1568,1200,406,276,4,2,-280,-2
DATA 1508,52,528,276,16,16,-16,-16
DATA 1568,1000,128,128,0,0,0,0
REM DATA 1508,640,200,300,0,0,0,0
DATA 1300,90,208,1396,0,0,0,0
DATA 1728,1000,128,128,0,0,0,0

Post Reply