home *** CD-ROM | disk | FTP | other *** search
- /* E tiny paint */
- /* By EA van Breemen */
-
- /* Redone with buttons and a area boundry by Kiernan Holland.
- ** Well that was fun... sorry for the lazy coding. You can
- ** probably tell that I am a VI freak the way I copied all my code.
- ** Yes, I did write it all at the keyboard (look ma no flowcharts),
- ** but it shows you how far you can go with only six hours of experience
- ** on E language. The Amazing thing is it compiles on my 3000,
- ** E will support the AGA chipset (meaning I could get 256 colors!!!)
- ** and the executables are very very small thanks to Wouter van Oortmerssen.
- ** All I need to implement is some sort of area fill (I need to know how
- ** to peek the pixel values) and maybe later I could put other goodies..
- ** I don't care if anyone messes with this code just as long as they
- ** don't try to sell the executables or the source for profit..
- */
-
- CONST MAXX = 480, /* Area Maximum X Axis */
- MINX = 160, /* Area Minimum X Axis */
- MAXY = 150, /* Area Maximum Y Axis */
- MINY = 50, /* Area Minimum Y Axis */
- LINEBNDX = 30, /* Location of LINE button */
- LINEBNDY = 100,
- QUITBNDX = 30, /* Location of QUIT button */
- QUITBNDY = 130,
- FREEBNDX = 30, /* Location of FREE button */
- FREEBNDY = 160,
- WIPEBNDX = 80, /* Location of WIPE button */
- WIPEBNDY = 100,
- BUTSIZ = 10, /* Angular Symmetric (???) Button Size */
- EXITCODE = 3 /* EXITCODE For Mouse Buttons (To be removed) */
-
- PROC main()
-
- DEF screen,
- window,
- x,
- y,
- pendown,
- stoppen,
- code,
- color,
- lastcolor,
- i,
- xmax = 640,
- ymax = 200,
- oldfunction,
- function
-
-
- screen := OpenS(xmax,ymax,4,$8000,'E painting program')
-
- IF screen=NIL THEN RETURN 10
-
- window:=OpenW(0,0,xmax,ymax,8,$1000,'E Tiny paint ', screen,15,0)
-
- IF window=NIL THEN RETURN CloseS(screen) AND 0+10
-
- pendown:=FALSE
- stoppen:=FALSE
- color:=1
- oldfunction := 0
- function := 0
-
- FOR i:=0 TO 15 STEP 1 DO Box(10+(i*15),20,i*15+20,30,i)
-
- Box(MINX,MINY,MAXX,MAXY,2)
-
- drawbut(LINEBNDX,LINEBNDY)
- resetcolor ()
- TextF(LINEBNDX-BUTSIZ,LINEBNDY-BUTSIZ,'LINE')
-
- drawbut(QUITBNDX,QUITBNDY)
- resetcolor ()
- TextF(QUITBNDX-BUTSIZ,QUITBNDY-BUTSIZ,'QUIT')
-
- drawbut(FREEBNDX,FREEBNDY)
- resetcolor ()
- TextF(FREEBNDX-BUTSIZ,FREEBNDY-BUTSIZ,'FREE')
-
- drawbut(WIPEBNDX,WIPEBNDY)
- resetcolor ()
- TextF(WIPEBNDX-BUTSIZ,WIPEBNDY-BUTSIZ,'WIPE')
-
- Box(10+(color*15),20,color*15+20,30,1)
- Box(10+(color*15)+1,21,color*15+19,29,color)
-
- REPEAT
- code:=Mouse()
-
- resetcolor ()
- TextF(200,160,'The MOUSE is in mode \d',code)
-
- SELECT code
- CASE 1
- pendown:=TRUE
- x:=MouseX(window)
- y:=MouseY(window)
- oldfunction := function
- function := mode(x,y)
- IF (function > 0)
- wait()
- pendown := FALSE
- ENDIF
- IF (function = 4)
- wipe ()
- function := oldfunction
- ENDIF
- IF (function = 0) THEN function := oldfunction
- CASE 0
- pendown:=FALSE
- CASE 2
- lastcolor:=color
- INC color
- IF color>15 THEN color:=0
- Box(10+(lastcolor*15),20,lastcolor*15+20,30,lastcolor)
- Box(10+(color*15),20,color*15+20,30,1)
- Box(10+(color*15)+1,21,color*15+19,29,color)
- Delay(10)
- CASE EXITCODE
- stoppen:=TRUE
- ENDSELECT
-
- IF (function <> 2)
- IF (pendown=TRUE) AND (function = 1)
- IF (x > MAXX) THEN x := MAXX
- IF (x < MINX) THEN x := MINX
- IF (y > MAXY) THEN y := MAXY
- IF (y < MINY) THEN y := MINY
- Plot(x,y,color)
- IF ((dline (x,y,color,window)) = 10) THEN stoppen := TRUE
- pendown := FALSE
- ENDIF
- IF (pendown=TRUE) AND (function = 3)
- IF (x > MAXX) THEN x := MAXX
- IF (x < MINX) THEN x := MINX
- IF (y > MAXY) THEN y := MAXY
- IF (y < MINY) THEN y := MINY
- Plot(x,y,color)
- IF ((freehand (x,y,color,window)) = 10) THEN stoppen := TRUE
- pendown := FALSE
- ENDIF
- ENDIF
-
- UNTIL function=2
-
- CloseW(window)
- CloseS(screen)
-
- ENDPROC
-
- PROC wipe ()
- Box(MINX,MINY,MAXX,MAXY,2)
- RETURN TRUE
- ENDPROC
-
-
- PROC freehand (startx,starty,curcolor,curwin)
-
- DEF movex,movey,button,oldlinex,oldliney
-
- oldlinex := startx
- oldliney := starty
- IF (oldlinex > MAXX) THEN oldlinex := MAXX
- IF (oldlinex < MINX) THEN oldlinex := MINX
- IF (oldliney > MAXY) THEN oldliney := MAXY
- IF (oldliney < MINY) THEN oldliney := MINY
-
- REPEAT /* take coordinates */
- button:=Mouse()
- movex:=MouseX(curwin)
- movey:=MouseY(curwin)
- IF (movex > MAXX) THEN movex := MAXX
- IF (movex < MINX) THEN movex := MINX
- IF (movey > MAXY) THEN movey := MAXY
- IF (movey < MINY) THEN movey := MINY
- resetcolor ()
- TextF(160,180,'Coordinates (x=\d, y=\d)',movex,movey)
- IF button = EXITCODE THEN RETURN FALSE /* jump out if Exit Code */
- Line(oldlinex,oldliney,movex,movey,curcolor)
- oldlinex := movex
- oldliney := movey
- UNTIL (button = 0)
- resetcolor ()
- TextF(160,180,' ')
- TextF(560,20,'Ready ')
- RETURN TRUE
- ENDPROC
-
-
- PROC dline (startx,starty,curcolor,curwin)
- DEF movex,movey,button
-
- REPEAT /* Wait until mouse buttons are depressed */
- button := Mouse()
- IF button = EXITCODE THEN RETURN FALSE /* Jump out if Exit Code */
- UNTIL (button = 0)
-
- resetcolor ()
- TextF(560,20,'Waiting ')
- Delay(15)
- TextF(560,20,'Make Line')
-
- REPEAT /* take coordinates */
- button:=Mouse()
- movex:=MouseX(curwin)
- movey:=MouseY(curwin)
- IF (movex > MAXX) THEN movex := MAXX
- IF (movex < MINX) THEN movex := MINX
- IF (movey > MAXY) THEN movey := MAXY
- IF (movey < MINY) THEN movey := MINY
- resetcolor ()
- TextF(160,180,'Coordinates (x=\d, y=\d)',movex,movey)
- IF button = EXITCODE THEN RETURN FALSE /* jump out if Exit Code */
- UNTIL (button = 1)
-
- Line(startx,starty,movex,movey,curcolor)
- resetcolor ()
- TextF(160,180,' ')
-
- REPEAT /* Wait until mouse buttons are depressed */
- button := Mouse()
- IF button = EXITCODE THEN RETURN FALSE /* Jump Out If Exit Code */
- UNTIL (button = 0)
- resetcolor ()
- TextF(560,20,'Waiting ')
- Delay(15)
- TextF(560,20,'Ready ')
- RETURN TRUE
- ENDPROC
-
-
- /* Delay a while to cut mouse sensitivity */
- PROC wait ( )
- resetcolor()
- TextF(560,20,'Waiting ')
- Delay(15)
- TextF(560,20,'Ready ')
- ENDPROC
-
-
- /* determine which button the user has pressed */
- PROC mode (locx,locy)
- /* could it be within the line boundry? */
- IF (locx > (LINEBNDX-BUTSIZ)) AND (locx < (LINEBNDX+BUTSIZ))
- IF (locy > (LINEBNDY-BUTSIZ)) AND (locy < (LINEBNDY+BUTSIZ))
- /* Turn Line Button On and Off */
- pressbut(LINEBNDX,LINEBNDY)
- resetcolor()
- TextF(LINEBNDX-BUTSIZ,LINEBNDY-BUTSIZ,'LINE')
- RETURN 1
- ENDIF
- ENDIF
-
- /* could it be within the quit boundry? */
- IF (locx > (QUITBNDX-BUTSIZ)) AND (locx < (QUITBNDX+BUTSIZ))
- IF (locy > (QUITBNDY-BUTSIZ)) AND (locy < (QUITBNDY+BUTSIZ))
- /* Turn Quit Button On and Off */
- pressbut(QUITBNDX,QUITBNDY)
- resetcolor()
- TextF(QUITBNDX-BUTSIZ,QUITBNDY-BUTSIZ,'QUIT')
- RETURN 2
- ENDIF
- ENDIF
-
- /* could it be within the free boundry? */
- IF (locx > (FREEBNDX-BUTSIZ)) AND (locx < (FREEBNDX+BUTSIZ))
- IF (locy > (FREEBNDY-BUTSIZ)) AND (locy < (FREEBNDY+BUTSIZ))
- /* Turn Quit Button On and Off */
- pressbut(FREEBNDX,FREEBNDY)
- resetcolor()
- TextF(FREEBNDX-BUTSIZ,FREEBNDY-BUTSIZ,'FREE')
- RETURN 3
- ENDIF
- ENDIF
-
- /* could it be within the wipe boundry? */
- IF (locx > (WIPEBNDX-BUTSIZ)) AND (locx < (WIPEBNDX+BUTSIZ))
- IF (locy > (WIPEBNDY-BUTSIZ)) AND (locy < (WIPEBNDY+BUTSIZ))
- /* Turn Quit Button On and Off */
- pressbut(WIPEBNDX,WIPEBNDY)
- resetcolor()
- TextF(WIPEBNDX-BUTSIZ,WIPEBNDY-BUTSIZ,'WIPE')
- RETURN 4
- ENDIF
- ENDIF
-
- /* it wasn't any of the above */
- RETURN 0
- ENDPROC
-
- /* This one simulates a button press at the given X and Y coordinates */
- PROC pressbut (x,y)
- Box(x-BUTSIZ,y-BUTSIZ,x+BUTSIZ,y+BUTSIZ,2)
- Box(x-BUTSIZ+2,y-BUTSIZ+2,x+BUTSIZ-2,y+BUTSIZ-2,1)
- Delay(5)
- Box(x-BUTSIZ,y-BUTSIZ,x+BUTSIZ,y+BUTSIZ,1)
- Box(x-BUTSIZ+2,y-BUTSIZ+2,x+BUTSIZ-2,y+BUTSIZ-2,2)
- ENDPROC
-
- /* This one draws a button in its depressed form (how depressing!) */
- PROC drawbut (x,y)
- Box(x-BUTSIZ,y-BUTSIZ,x+BUTSIZ,y+BUTSIZ,1)
- Box(x-BUTSIZ+2,y-BUTSIZ+2,x+BUTSIZ-2,y+BUTSIZ-2,2)
- ENDPROC
-
- PROC resetcolor ()
- Plot(0,0,1)
- ENDPROC
-