And the new program of the week is... Pixelation!!
This program is a complete art program, with complete mouse control and a load/save function. I used Screen 7 because I could not store all of the pixels of Screen 12 to an array with GET. *Memory Limitations* :D
Controls for Pixelation:
Tools: click on the picture of the current tool to change tools.
Pencil Tool: click, hold, and drag the mouse
Line Tool: click and drag from the starting position and release at the other end of the line
Rectangle Tool: click and drag from one corner of the rectangle and release at the other corner of the box
Circle Tool: click and drag from the center of the circle and release at a point on the circle
Paint Tool: click to paint
Fat Pen Tool: click or click and drag to use the fat pen, which makes a good eraser
Text Tool: click and start typing. press enter when finished typing
Colors: click on a color to select it. the current color is drawn at the top left
Load and Save: click to save. type a valid filename. the file will be saved to drive c with a .txt extension. if the typed filename is too long or too short, the last filename used will be used. the default filename is picture if the file cannot be loaded or saved, an error message will display briefly as it attempts to access the file. the picture is saved as pixsnap when you quit, so your work is not lost
Quit: click quit, or press q or escape to quit
Right Button: for rectangles, lines and circles, the starting position for drawing the rectangle or circle is defined as you press the left button (and continue to hold and drag it). but if you press the right button at all, it is used to define the starting position. for circles, right click at the center of the circle, and then click and drag to a point on the circle. it is similiar for rectangles and lines, too
Clearing the Screen: press the spacebar or the middle mouse button to clear the drawing area
-
'Pixelation! (or) Pixel Nation! Drawing Program Version 1.0
'(C) 2006 i-TECH and King Kristopher
DECLARE SUB MouseDriver (ax AS INTEGER, bx AS INTEGER, cx AS INTEGER, dx AS INTEGER)
DECLARE FUNCTION MouseExists% ()
DECLARE SUB MouseStatus (mouseX, mouseY, leftB, rightB, middleB)
DECLARE SUB MousePosition (newX, newY)
DECLARE SUB MouseSetArea (x1, y1, x2, y2)
CONST TRUE = -1: CONST FALSE = 0
CONST LEFT = 0: CONST RIGHT = 1: CONST CENTER = 2
MouseData:
DATA 55,89,E5,8B,76,06,8B,14,8B,76,08,8B,0C,8B,76,0A
DATA 8B,1C,8B,76,0C,8B,04,1E,07,CD,33,8B,76,06,89,14
DATA 8B,76,08,89,0C,8B,76,0A,89,1C,8B,76,0C,89,04,5D
DATA CA,08,00
MouseSetArea 5, 5, 314, 194
SCREEN 7: CLS : COLOR 15: RANDOMIZE TIMER: CHDIR "C:/": ON ERROR GOTO errors
DIM c%(1 TO 100), m%(1 TO 3000), s%(1 TO 14000): GET (55, 0)-(319, 199), s%
DIM t1%(1 TO 500), t2%(1 TO 500), t3%(1 TO 500), t4%(1 TO 500), t5%(1 TO 500), t6%(1 TO 500), t7%(1 TO 500)
'main variables
c = 4 'initial color
filename$ = "picture" 'initial filename (file extension added automatically)
prb = FALSE 'for circles, if rb has been pressed at all, then it is used to mark the center of the circle. other wise, the center is defined by when you started holding lb
t = 1 'initial tool
'other variables
key$ = "": framecount = 0: s = 0: plb = FALSE
x = 187: y = 100: MousePosition x, y: p = x: q = y
LINE (6, 0)-(10, 4), 6, B: CIRCLE (8, 2), 2, 5: LINE (7, 1)-(9, 3), 9, BF
GET (6, 0)-(10, 4), c%
'graphics for tools
LINE (6, 17)-(53, 54), 1, BF: LINE (10, 21)-(39, 25), 7
LINE (39, 25)-(40, 30), 7: LINE (40, 30)-(20, 35), 7
LINE (20, 35)-(15, 39), 7: LINE (15, 39)-(20, 44), 7
LINE (20, 44)-(50, 35), 7: LINE (50, 35)-(36, 50), 7
LINE (36, 50)-(9, 45), 7: LINE (9, 45)-(11, 35), 7
GET (6, 17)-(53, 54), t1%
LINE (6, 17)-(53, 54), 2, BF: LINE (10, 21)-(49, 50), 7
GET (6, 17)-(53, 54), t2%
LINE (6, 17)-(53, 54), 3, BF: LINE (10, 21)-(49, 50), 7, B
GET (6, 17)-(53, 54), t3%
LINE (6, 17)-(53, 54), 4, BF: CIRCLE (29, 35), 18, 7
GET (6, 17)-(53, 54), t4%
LINE (6, 17)-(53, 54), 5, BF: LINE (8, 45)-(51, 35), 7
CIRCLE (29, 35), 14, 7: PAINT (29, 35), 7, 7
GET (6, 17)-(53, 54), t5%
LINE (6, 17)-(53, 54), 6, BF: CIRCLE (32, 32), 10, 7
LINE (11, 22)-(27, 38), 7, BF: LINE (21, 32)-(37, 48), 7, BF
GET (6, 17)-(53, 54), t6%
LINE (6, 17)-(53, 54), 7, BF: LINE (15, 20)-(25, 50), 8
LINE (30, 20)-(40, 50), 8: CIRCLE (28, 35), 12, 8
LOCATE 5, 1: PRINT " " + CHR$(1) + " " + CHR$(3) + " " + CHR$(14) + " "
GET (6, 17)-(53, 54), t7%
'menu graphics
FOR a = 0 TO 7
LINE (6, a * 10 + 64)-(29, a * 10 + 73), a, BF
LINE (30, a * 10 + 64)-(53, a * 10 + 73), a + 8, BF
NEXT a
LINE (5, 0)-(54, 199), 2, B: LINE (6, 1)-(53, 6), c, BF
LINE (6, 7)-(53, 16), 8, B: LINE (6, 55)-(53, 64), 8, B
LINE (6, 143)-(53, 152), 4, B: LINE (6, 153)-(53, 158), 2, BF
LINE (6, 159)-(53, 169), 4, B: LINE (6, 170)-(53, 174), 2, BF
LINE (6, 175)-(53, 184), 4, B: LINE (6, 185)-(53, 198), 2, BF
LOCATE 2, 2: PRINT "Tools": LOCATE 8, 2: PRINT "Color"
LOCATE 19, 2: PRINT "Load" + CHR$(4)
LOCATE 21, 2: PRINT "Save" + CHR$(5)
LOCATE 23, 2: PRINT "Quit" + CHR$(6)
PUT (6, 17), t1%, PSET 'this should equal the initial tool
GET (0, 0)-(54, 199), m%
WHILE key$ <> "q" AND key$ <> CHR$(27) AND NOT (x < 55 AND lb = TRUE AND plb = FALSE AND y > 174 AND y < 186)
l = x: w = y: plb = lb: IF rb = TRUE THEN prb = TRUE 'if plb and not lb then you released mouse
MouseStatus x, y, lb, rb, mb
IF x <> l OR w <> y THEN PUT (0, 0), m%, PSET
IF (x <> l OR w <> y) AND (x > 52 OR l > 52) THEN PUT (55, 0), s%, PSET
PUT (x - 2, y - 2), c%, PSET
IF x > 54 THEN 'do drawing or controls
SELECT CASE t 'tools
CASE 1 'pencil tool
IF lb = TRUE THEN PUT (55, 0), s%, PSET: LINE (l, w)-(x, y), c: GET (55, 0)-(319, 199), s%
CASE 2 'line tool
IF rb = TRUE OR (lb = TRUE AND plb = FALSE AND prb = FALSE) THEN p = x: q = y
IF lb = TRUE THEN LINE (p, q)-(x, y), c
IF lb = FALSE AND plb = TRUE THEN PUT (55, 0), s%, PSET: LINE (p, q)-(x, y), c: GET (55, 0)-(319, 199), s%
CASE 3 'rectangle tool
IF rb = TRUE OR (lb = TRUE AND plb = FALSE AND prb = FALSE) THEN p = x: q = y
IF lb = TRUE THEN LINE (p, q)-(x, y), c, B
IF lb = FALSE AND plb = TRUE THEN PUT (55, 0), s%, PSET: LINE (p, q)-(x, y), c, B: GET (55, 0)-(319, 199), s%
CASE 4 'circle tool
IF rb = TRUE OR (lb = TRUE AND plb = FALSE AND prb = FALSE) THEN p = x: q = y
s = SQR((p - x) * (p - x) + (q - y) * (q - y))
IF lb = TRUE THEN CIRCLE (p, q), ABS(s), c
IF lb = FALSE AND plb = TRUE THEN PUT (55, 0), s%, PSET: CIRCLE (p, q), ABS(s), c: GET (55, 0)-(319, 199), s%
CASE 5 'paint tool
IF lb = TRUE THEN PUT (55, 0), s%, PSET: PAINT (x, y), c, c: PUT (0, 0), m%, PSET: GET (55, 0)-(319, 199), s%
CASE 6 'fat pen tool
IF lb = TRUE THEN PUT (55, 0), s%, PSET: LINE (x - 8, y - 8)-(x + 8, y + 8), c, BF: GET (55, 0)-(319, 199), s%
CASE 7 'text tool
IF lb = TRUE THEN
COLOR c: LOCATE INT(y / 8) + 1, INT(x / 8) - 1: INPUT yourtext$
PUT (55, 0), s%, PSET: LOCATE INT(y / 8) + 1, INT(x / 8) + 1: PRINT yourtext$: PUT (0, 0), m%, PSET: GET (55, 0)-(319, 199), s%
END IF
END SELECT
ELSE 'up - draw | down - menu controls
IF lb = TRUE AND plb = FALSE THEN 'have to click; can't click and hold
'change tool
IF y > 16 AND y < 55 THEN
PUT (0, 0), m%, PSET
t = t + 1: IF t = 8 THEN t = 1
SELECT CASE t
CASE 1: PUT (6, 17), t1%, PSET 'pencil
CASE 2: PUT (6, 17), t2%, PSET 'lines
CASE 3: PUT (6, 17), t3%, PSET 'rectangles
CASE 4: PUT (6, 17), t4%, PSET 'circles
CASE 5: PUT (6, 17), t5%, PSET 'paint
CASE 6: PUT (6, 17), t6%, PSET 'fat pen
CASE 7: PUT (6, 17), t7%, PSET 'text
END SELECT
GET (0, 0)-(54, 199), m%
END IF
'change color
IF y > 63 AND y < 143 THEN
c = INT((y - 64) / 10): IF x > 29 THEN c = c + 8
PUT (0, 0), m%, PSET: LINE (6, 1)-(53, 6), c, BF: GET (0, 0)-(54, 199), m%
END IF
'load picture
IF y > 142 AND y < 154 THEN
LOCATE 2, 9: INPUT "Name: ", newname$
IF LCASE$(newname$) <> "cancel" THEN
IF newname$ <> "" AND LEN(newname$) < 9 THEN filename$ = newname$ ELSE LOCATE 2, 15: PRINT filename$
OPEN filename$ + ".txt" FOR INPUT AS #1
INPUT #1, info$
FOR a = 1 TO 14000
INPUT #1, s%(a)
NEXT a
CLOSE #1
END IF
PUT (55, 0), s%, PSET
END IF
'save picture
IF y > 158 AND y < 170 THEN
LOCATE 2, 9: INPUT "Name: ", newname$
IF LCASE$(newname$) <> "cancel" THEN
IF newname$ <> "" AND LEN(newname$) < 9 THEN filename$ = newname$ ELSE LOCATE 2, 15: PRINT filename$
OPEN filename$ + ".txt" FOR OUTPUT AS #1
WRITE #1, filename$ + " (C) " + TIME$ + ", " + DATE$ + " i-TECH and King Kristopher"
FOR a = 1 TO 14000
WRITE #1, s%(a)
NEXT a
CLOSE #1
END IF
PUT (55, 0), s%, PSET
END IF
END IF
END IF
'clear screen
IF key$ = " " OR mb = TRUE THEN LINE (55, 0)-(319, 199), 0, BF: GET (55, 0)-(319, 199), s%
key$ = INKEY$
WEND
'saves when quitting
OPEN "pixsnap.txt" FOR OUTPUT AS #1
WRITE #1, "This is the last snapshot from Pixelation. (C) 2006 i-TECH and King Kristopher"
FOR a = 1 TO 14000
WRITE #1, s%(a)
NEXT a
CLOSE #1
SYSTEM
errors:
LOCATE 3, 9: PRINT "Error"
RESUME NEXT
SUB MouseDriver (ax AS INTEGER, bx AS INTEGER, cx AS INTEGER, dx AS INTEGER)
STATIC called AS INTEGER, mouseDrv AS STRING
DIM mCount AS INTEGER, mData AS STRING
IF NOT called THEN 'the first time this sub is called, there is some
called = TRUE 'initialization that needs to be done
RESTORE MouseData
FOR mCount = 1 TO 51
READ mData
mouseDrv = mouseDrv + CHR$(VAL("&H" + mData))
NEXT mCount
'checks for mouse driver
IF NOT MouseExists THEN PRINT "No Mouse Driver": END
END IF
DEF SEG = VARSEG(mouseDrv)
CALL ABSOLUTE(ax, bx, cx, dx, SADD(mouseDrv))
DEF SEG
END SUB
FUNCTION MouseExists%
DIM ax AS INTEGER
ax = 0
MouseDriver ax, 0, 0, 0
MouseExists% = ax
END FUNCTION
SUB MousePosition (newX, newY)
DIM cx AS INTEGER, dx AS INTEGER
cx = newX
dx = newY
MouseDriver 4, 0, cx, dx
END SUB
SUB MouseSetArea (x1, y1, x2, y2)
DIM cx AS INTEGER, dx AS INTEGER
cx = x1 'set horizontal range
dx = x2
MouseDriver 7, 0, cx, dx
cx = y1 'set vertical range
dx = y2
MouseDriver 8, 0, cx, dx
END SUB
SUB MouseStatus (mouseX, mouseY, leftB, rightB, middleB)
DIM bx AS INTEGER, cx AS INTEGER, dx AS INTEGER
MouseDriver 3, bx, cx, dx
'the bits in bx contain the button status
'bit 0 = left; bit 1 = right; bit 2 = middle
IF (bx AND 1) THEN leftB = TRUE ELSE leftB = FALSE
IF (bx AND 2) THEN rightB = TRUE ELSE rightB = FALSE
IF (bx AND 4) THEN middleB = TRUE ELSE middleB = FALSE
mouseX = cx
mouseY = dx
END SUB
|