'===========================================================================
' Subject: VGA CLIP EDITOR                   Date: Year of 1990           
' Author:  Earl Montgomery                   Code: QB, PDS                
' Origin:  For use with VGACLIP.EXE        Packet: GRAPHICS.ABC
'===========================================================================
' $INCLUDE: 'qb.bi'
DEFINT K, P
ON ERROR GOTO errorroutine
DIM B(500)
DIM d(100)
DIM PIX(1000)
DIM inreg AS RegType
DIM outreg AS RegType
restart:
SCREEN 0: CLS
PRINT "CLIPEDv6.BAS": PRINT "Copyright (C) Earl Montgomery 1990"
PRINT
GOSUB keyboard
begin:
SCREEN 13: DEF SEG = &HA000
DRAW "c142;bm100,100;r4;br2;bu2;u3;bd5;br2;r4;bl6;bd2;d3;"
DRAW "bm2,2;r6;d6;l6;u6;"
GET (2, 2)-(8, 8), d
GET (98, 92)-(114, 108), B
CLS
OUT &H3C8, 0
FOR k = 0 TO 767: OUT &H3C9, 0: NEXT
DEF SEG = &HA000
BLOAD n$ + ".cap", 0: DEF SEG = &HA000 + 4000
OUT &H3C8, 0
FOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXT
REM Main Program
x% = 160: y% = 100
cursor:
PUT (x%, y%), B
inkey1:
i$ = INKEY$: IF i$ = "" THEN GOTO inkey1
IF i$ = " " THEN GOTO inkey1
PUT (x%, y%), B
AA% = ASC(i$) AND 223
IF AA% = 0 THEN GOTO mainkeyboardscan
IF AA% = 71 THEN COLOR 15: CLS : SCREEN 0: DEF SEG : END
IF AA% = 83 THEN GOTO preparetoexit
IF AA% = 72 THEN GOTO helpscrn
IF AA% = 90 THEN GOTO zoom
GOTO cursor
mainkeyboardscan:
IF ASC(MID$(i$, 2)) = 75 THEN x% = x% - 2
IF ASC(MID$(i$, 2)) = 77 THEN x% = x% + 2
IF ASC(MID$(i$, 2)) = 72 THEN y% = y% - 2
IF ASC(MID$(i$, 2)) = 80 THEN y% = y% + 2
IF ASC(MID$(i$, 2)) = 71 THEN x% = x% - 2: y% = y% - 2
IF ASC(MID$(i$, 2)) = 79 THEN x% = x% - 2: y% = y% + 2
IF ASC(MID$(i$, 2)) = 73 THEN x% = x% + 2: y% = y% - 2
IF ASC(MID$(i$, 2)) = 81 THEN x% = x% + 2: y% = y% + 2
IF x% > 300 THEN x% = 300
IF x% < 6 THEN x% = 6
IF y% > 180 THEN y% = 180
IF y% < 5 THEN y% = 5
GOTO cursor
helpscrn:
DEF SEG = &HA000: BSAVE "temp.bin", 0, 64780!: CLS

DEF SEG = &HA000 + 4000
OUT &H3C7, 0
FOR k = 0 TO 767
A = INP(&H3C9)
POKE k, A
NEXT
SCREEN 9
COLOR 12, 0
PRINT "Command from main screen:"
PRINT "<G>=Good Bye  <H>=This menu."
PRINT "<S>=Press this key before saving the picture using VGACLIP!"
PRINT "<Z>=Go to ZOOM Edit Mode."
PRINT
PRINT "Commands from ZOOM Edit Mode:"
PRINT "<D>=Pen-Down Mode."
PRINT "<C>=Increases color value."
PRINT "<->=Decreases color value."
PRINT "<F>=Changes color to the same color as one block to the right."
PRINT "<L>=Return to the main screen without saving the editing."
PRINT "<S>=Saves your editing and returns to the main screen."
PRINT "<U>=Pen Up Mode."
PRINT "Use the arrow keys on the keypad to move the cursor. Home moves"
PRINT "the cursor up and to the left. PgUp moves it up and to the right."
PRINT "End moves it down and to the left and PgDn moves it down and to"
PRINT "the right. All keys are repeat keys. Just hold them down!"
PRINT "Press any key to continue."
inkey2:
Z$ = INKEY$: IF Z$ = "" THEN GOTO inkey2
SCREEN 13
OUT &H3C8, 0: FOR k = 0 TO 767: OUT &H3C9, 0: NEXT
DEF SEG = &HA000: BLOAD "temp.bin", 0
DEF SEG = &HA000 + 4000
OUT &H3C8, 0
FOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXT
GOTO cursor
zoom:
GET (x%, y%)-(x% + 19, y% + 19), PIX
DEF SEG = &HA000 + 4000
OUT &H3C7, 0
FOR k = 0 TO 767: A = INP(&H3C9): POKE k, A: NEXT
DEF SEG = &HA000: BSAVE "temp.bin", 0, 64780!
CLS : PUT (50, 50), PIX, PSET
FOR y = 4 TO 164 STEP 8
LINE (100, y)-(260, y), 142
NEXT
FOR x = 100 TO 260 STEP 8
LINE (x, 4)-(x, 164), 142
NEXT
x = 160: y = 100
X1 = 59: Y1 = 60
i% = 1
OPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$
FOR y = 50 TO 69
FOR x = 50 TO 69
LSET O$ = CHR$(POINT(x, y)): PUT 1, i%
i% = i% + 1
NEXT x, y
CLOSE #1
i% = 1

OPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$
FOR y = 6 TO 164 STEP 8
FOR x = 102 TO 260 STEP 8
GET #1, i%: i% = i% + 1
IF ASC(O$) = 142 THEN PAINT (x, y), 143, 142: GOTO skipover
PAINT (x, y), ASC(O$), 142
skipover:
NEXT x, y
CLOSE #1
x = 176: y = 88
flag$ = "jump"
LINE (170, 180)-(190, 198), 142, B
c = POINT(x, y)
IF c = 142 THEN c = 143
PAINT (180, 185), c, 142: LOCATE 25, 30: PRINT c;
inkey3:
i$ = INKEY$: IF i$ = "" THEN GOSUB putcursor: GOTO inkey3
AA = ASC(i$)
IF AA = 0 THEN GOTO keyboardscanfromzoom
IF i$ = "d" OR i$ = "D" THEN flag$ = ""
IF i$ = "c" OR i$ = "C" THEN c = c + 1: IF c > 255 THEN c = 0
IF i$ = "-" OR i$ = "_" THEN c = c - 1: IF c < 0 THEN c = 0
IF c = 142 AND i$ = "-" OR i$ = "_" THEN c = 141
IF c = 142 AND i$ = "c" OR i$ = "C" THEN c = 143
IF i$ = "c" OR i$ = "C" THEN GOSUB printnewcolor
IF i$ = "-" OR i$ = "_" THEN GOSUB printnewcolor
IF i$ = "f" OR i$ = "F" THEN c = POINT(x + 8, y): IF c = 142 THEN c = 143
IF i$ = "s" OR i$ = "S" THEN GOTO savefromkeyboard
IF i$ = "l" OR i$ = "L" THEN GOSUB bloadscrn: GOTO cursor
IF i$ = "u" OR i$ = "U" THEN flag$ = "jump"
IF flag$ = "" THEN PAINT (x, y), c, 142: PSET (X1, Y1), c
PUT (x - 3, y - 3), d: FOR d = 0 TO 50: NEXT: PUT (x - 3, y - 3), d
i$ = "": GOTO inkey3
keyboardscanfromzoom:
IF ASC(MID$(i$, 2)) = 75 THEN x = x - 8: X1 = X1 - 1
IF ASC(MID$(i$, 2)) = 77 THEN x = x + 8: X1 = X1 + 1
IF ASC(MID$(i$, 2)) = 72 THEN y = y - 8: Y1 = Y1 - 1
IF ASC(MID$(i$, 2)) = 80 THEN y = y + 8: Y1 = Y1 + 1
IF ASC(MID$(i$, 2)) = 71 THEN x = x - 8: y = y - 8: X1 = X1 - 1: Y1 = Y1 - 1
IF ASC(MID$(i$, 2)) = 79 THEN x = x - 8: y = y + 8: X1 = X1 - 1: Y1 = Y1 + 1
IF ASC(MID$(i$, 2)) = 73 THEN x = x + 8: y = y - 8: X1 = X1 + 1: Y1 = Y1 - 1
IF ASC(MID$(i$, 2)) = 81 THEN x = x + 8: y = y + 8: X1 = X1 + 1: Y1 = Y1 + 1
IF x > 256 THEN x = 256
IF x < 104 THEN x = 104
IF y > 160 THEN y = 160
IF y < 8 THEN y = 8
IF X1 < 50 THEN X1 = 50
IF X1 > 69 THEN X1 = 69
IF Y1 > 69 THEN Y1 = 69
IF Y1 < 50 THEN Y1 = 50
IF flag$ = "jump" THEN GOSUB putcursor: GOTO inkey3
PAINT (x, y), c, 142
PSET (X1, Y1), c
GOTO inkey3
savefromkeyboard:
GET (50, 50)-(69, 69), PIX
DEF SEG = &HA000: BLOAD "temp.bin", 0
PUT (x%, y%), PIX, PSET
GOTO cursor

preparetoexit:
REM blanks cursor and saves-ends
PUT (x%, y%), B: PUT (x%, y%), B
inkey4:
i$ = INKEY$: IF i$ = "" THEN GOTO inkey4
IF i$ = "g" OR i$ = "G" THEN CLS : SCREEN 0: END
GOTO inkey4
errorroutine:
SCREEN 0: WIDTH 80: CLS : RESUME restart
keyboard:
DIM inregs AS RegTypeX, outregs AS RegTypeX
filespec$ = "*.cap" + CHR$(0)
PRINT STRING$(75, 196)
inregs.ax = &H2F00
CALL INTERRUPTX(&H21, inregs, outregs)
data.seg = outregs.es
data.off = outregs.bx
inregs.ax = &H4E00
inregs.dx = SADD(filespec$)
inregs.ds = -1
CALL INTERRUPTX(&H21, inregs, outregs)
cy = outregs.flags AND 1
IF cy = 0 THEN
WHILE cy = 0
DEF SEG = data.seg
f.name$ = ""
i = data.off + 30
WHILE PEEK(i) <> 0
f.name$ = f.name$ + CHR$(PEEK(i))
i = i + 1
WEND
DEF SEG
PRINT f.name$ + " ";
inregs.ax = &H4F00
CALL INTERRUPTX(&H21, inregs, outregs)
cy = outregs.flags AND 1
WEND
ELSE GOSUB PRINTNOCAPFILES
END IF
PRINT STRING$(75, 196)
INPUT "Filename to load"; n$
RETURN
PRINTNOCAPFILES:
PRINT "There are no .CAP files in this directory."
PRINT STRING$(75, 196)
INKEY5:
i$ = INKEY$: IF i$ = "" THEN GOTO INKEY5
DEF SEG : CLS : SCREEN 0: WIDTH 80: END
putcursor:
PUT (x - 3, y - 3), d
FOR d = 0 TO 50: NEXT
PUT (x - 3, y - 3), d
RETURN
printnewcolor:
PAINT (180, 185), c, 142
LOCATE 25, 30
PRINT "    ";
LOCATE 25, 30
PRINT c;
RETURN
bloadscrn:
CLS
DEF SEG = &HA000
BLOAD "temp.bin", 0
RETURN