TGC Codebase Backup



"paint" by Sven B

27th Dec 2004 7:08
Summary

It's not really a paint program. I didn't program the freehand tool for example. But it makes a good start...



Description



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `***************************************
`paint
`***************************************

sync on : sync rate 0

dim line(1000,5) : lines=0
dim circle(1000,4) : circles=0
dim fbox(1000,5) : dim ebox(1000,5) : fboxes=0 : eboxes=0
dim ellipse(1000,5) : ellipses=0
mode$="" : message$=""

red=55
green=255
blue=25

color=rgb(red,green,blue)

do

	message$=""

	cls

	ink color,0

	if draw=1 then gosub draw
	gosub display
	gosub interface

	sync
loop

`*********
`submenu's
`*********

draw:

	if mode$="line"
		if mouseclick()=1
			if mode=0
				mode=1
				startx=mousex()
				starty=mousey()
			endif
			if mode=1
				line startx,starty,mousex(),mousey()
			endif
		endif
		if mouseclick()=0 and mode=1
			mode=0
			inc lines
			line(lines,1)=startx : line(lines,2)=starty
			line(lines,3)=mousex() : line(lines,4)=mousey()
			line(lines,5)=color
		endif
	endif

	if mode$="circle"
		if mouseclick()=1
			if mode=0
				mode=1
				startx=mousex()
				starty=mousey()
			endif
			if mode=1
				circle startx,starty,mousex()-startx
			endif
		endif
		if mouseclick()=0 and mode=1
			mode=0
			inc circles
			circle(circles,1)=startx : circle(circles,2)=starty
			circle(circles,3)=mousex()-startx
			circle(circles,4)=color
		endif
	endif

	if mode$="fbox"
		if mouseclick()=1
			if mode=0
				mode=1
				startx=mousex()
				starty=mousey()
			endif
			if mode=1
				box startx,starty,mousex(),mousey()
			endif
		endif
		if mouseclick()=0 and mode=1
			mode=0
			inc fboxes
			fbox(fboxes,1)=startx : fbox(fboxes,2)=starty
			fbox(fboxes,3)=mousex() : fbox(fboxes,4)=mousey()
			fbox(fboxes,5)=color
		endif
	endif

	if mode$="ebox"
		if mouseclick()=1
			if mode=0
				mode=1
				startx=mousex()
				starty=mousey()
			endif
			if mode=1
				line startx,starty,mousex(),starty
				line startx,starty,startx,mousey()
				line mousex(),mousey(),startx,mousey()
				line mousex(),mousey(),mousex(),starty
			endif
		endif
		if mouseclick()=0 and mode=1
			mode=0
			inc eboxes
			ebox(eboxes,1)=startx : ebox(eboxes,2)=starty
			ebox(eboxes,3)=mousex() : ebox(eboxes,4)=mousey()
			ebox(eboxes,5)=color
		endif
	endif

	if mode$="ellipse"
		if mouseclick()=1
			if mode=0
				mode=1
				startx=mousex()
				starty=mousey()
			endif
			if mode=1
				ellipse startx,starty,mousex()-startx,mousey()-starty
			endif
		endif
		if mouseclick()=0 and mode=1
			mode=0
			inc ellipses
			ellipse(ellipses,1)=startx : ellipse(ellipses,2)=starty
			ellipse(ellipses,3)=mousex()-startx : ellipse(ellipses,4)=mousey()-starty
			ellipse(ellipses,5)=color
		endif
	endif
	
return

display:

	if lines>0 and lines<1000
		for x=1 to lines
			ink line(x,5),0
			line line(x,1),line(x,2),line(x,3),line(x,4)
		next x
	endif

	if circles>0 and circles<1000
		for x=1 to circles
			ink circle(x,4),0
			circle circle(x,1),circle(x,2),circle(x,3)
		next x
	endif
	
	if fboxes>0 and fboxes<1000
		for x=1 to fboxes
			ink fbox(x,5),0
			box fbox(x,1),fbox(x,2),fbox(x,3),fbox(x,4)
		next x
	endif
	
	if eboxes>0 and eboxes<1000
		for x=1 to eboxes
			ink ebox(x,5),0
			line ebox(x,1),ebox(x,2),ebox(x,3),ebox(x,2)
			line ebox(x,1),ebox(x,2),ebox(x,1),ebox(x,4)
			line ebox(x,3),ebox(x,4),ebox(x,3),ebox(x,2)
			line ebox(x,3),ebox(x,4),ebox(x,1),ebox(x,4)
		next x
	endif
	
	if ellipses>0 and ellipses<1000
		for x=1 to ellipses
			ink ellipse(x,5),0
			ellipse ellipse(x,1),ellipse(x,2),ellipse(x,3),ellipse(x,4)
		next x
	endif

return

interface:

	ink rgb(0,0,0),0 : box 1,screen height()-30,screen width()-1,screen height()-1
	ink rgb(200,200,200),0 : line 0,screen height()-30,screen width()-1,screen height()-30

	if mousey()>screen height()-30 then draw=0 else draw=1

	`line	
	if mousey()>screen height()-30 and mousex()<30 
		message$="draw a line"
		ink rgb(255,0,0),0
		if mouseclick()=1 then mode$="line" 
	else
		message$=""
		ink rgb(200,200,200),0
	endif
	line 5,screen height()-5,25,screen height()-25

	`circle
	if mousey()>screen height()-30 and mousex()>30 and mousex()<60
		message$="draw a circle"
		ink rgb(255,0,0),0
		if mouseclick()=1 then mode$="circle"
	else
		ink rgb(200,200,200),0
	endif
	circle 45,screen height()-15,10

	`filled box
	if mousey()>screen height()-30 and mousex()>60 and mousex()<90
		message$="draw a filled box"
		ink rgb(255,0,0),0
		if mouseclick()=1 then mode$="fbox"
	else
		ink rgb(200,200,200),0
	endif
	box 65,screen height()-25,85,screen height()-5

	`empty box
	if mousey()>screen height()-30 and mousex()>90 and mousex()<120
		message$="draw an empty box"	
		ink rgb(255,0,0),0
		if mouseclick()=1 then mode$="ebox"
	else

		ink rgb(200,200,200),0
	endif
	line 95,screen height()-25,115,screen height()-25
	line 95,screen height()-25,95,screen height()-5
	line 95,screen height()-5,115,screen height()-5
	line 115,screen height()-25,115,screen height()-5	

	`ellipse
	if mousey()>screen height()-30 and mousex()>120 and mousex()<150
		message$="draw an ellipse"
		ink rgb(255,0,0),0
		if mouseclick()=1 then mode$="ellipse"
	else

		ink rgb(200,200,200),0
	endif
	ellipse 135,screen height()-15,10,7

	`color
	if mousey()>screen height()-30 and mousex()>150 and mousex()<180
		message$="choose color"
		ink rgb(255,0,0),0
		if mouseclick()=1 and hold=0 then hold=1 : gosub choose_color
	else

		ink color,0
	endif
	box 155,screen height()-20,175,screen height()-10

	`exit
	if button(320,screen height()-15,"exit")>0 then end

	`message
	ink rgb(255,255,255),0
	if draw=1
		if mode$="line" then message$="drag the mouse to draw a line"
		if mode$="circle" then message$="drag the mouse to draw a circle"
		if mode$="fbox" then message$="drag the mouse to draw a filled box"
		if mode$="ebox" then message$="drag the mouse to draw an empty box"
		if mode$="ellipse" then message$="drag the mouse to draw an ellipse"
	endif
	text screen width()-10-text width(message$),screen height()-23,message$

return

choose_color:

mode$=""

do

	cls

	`interface
	ink rgb(200,200,200),0 : line 0,screen height()-30,screen width()-1,screen height()-30
	line 5,screen height()-5,25,screen height()-25
	circle 45,screen height()-15,10
	box 65,screen height()-25,85,screen height()-5
	line 95,screen height()-25,115,screen height()-25
	line 95,screen height()-25,95,screen height()-5
	line 95,screen height()-5,115,screen height()-5
	line 115,screen height()-25,115,screen height()-5	
	ellipse 135,screen height()-15,10,7
	gosub display
	ink rgb(red,green,blue),0
	box 155,screen height()-20,175,screen height()-10

	`display red,green and blue values
	ink rgb(255,255,255),0 
		box 154,screen height()-285,159,screen height()-30
		box 161,screen height()-285,166,screen height()-30
		box 168,screen height()-285,173,screen height()-30

	ink rgb(255,0,0),0 : box 154,screen height()-30-red,159,screen height()-30
	ink rgb(0,255,0),0 : box 161,screen height()-30-green,166,screen height()-30
	ink rgb(0,0,255),0 : box 168,screen height()-30-blue,173,screen height()-30
	if mousey()<screen height()-30 
		if mouseclick()=1
			if mousex()>154 and mousex()<159 then red=screen height()-30-mousey()
			if mousex()>161 and mousex()<166 then green=screen height()-30-mousey()
			if mousex()>168 and mousex()<173 then blue=screen height()-30-mousey()
			if red>255 then red=255
			if green>255 then green=255
			if blue>255 then blue=255
		endif
	else
		if mouseclick()=1 and hold=0 then color=rgb(red,green,blue) : exit
	endif

	if mouseclick()=0 then hold=0
	
	sync
loop

return

`********
`function
`********

function button(x,y,text$)
	pressed=0
	tx=text width(text$)
	ty=text height(text$)
	if mousex()>x and mousex()<x+tx
		if mousey()>y-ty and mousey()<y+ty
			pressed=1
		endif
	endif
	if pressed=1 then ink rgb(255,0,0),0 else ink rgb(200,200,200),0
	set text size 18 : text x,y-8,text$
	if mouseclick()=0 then pressed=0
endfunction pressed