'$DYNAMIC
DECLARE FUNCTION npt! (a$, tmp25!)
DECLARE FUNCTION match! (rtmp!, gtmp!, btmp!)
DECLARE SUB help ()
DECLARE SUB loadpalette ()
DECLARE SUB loadpic (tmp90!)
DECLARE SUB savepic ()
DECLARE SUB hflip ()
DECLARE SUB vflip ()
DECLARE SUB inverse ()
DECLARE SUB clrchng ()
DECLARE SUB save ()
DECLARE SUB multiply ()
DECLARE SUB picture ()
DECLARE SUB loadfile (aa$)
'waiting to be incorporated:

'mirror on axises
'ratio change (1 tolerance)
'ratio multiply
'cut,paste,select for changing

SCREEN 13


OPTION BASE 0
DIM SHARED r(255) AS INTEGER, g(255) AS INTEGER, b(255) AS INTEGER
DIM SHARED pxl(1 TO 64, 1 TO 64) AS INTEGER, mtch(255) AS INTEGER, mtchc(255) AS INTEGER, inv(255) AS INTEGER, aa AS INTEGER, w AS INTEGER, h AS INTEGER
DIM SHARED file$, ffile$, ltmp50$, ext$, strtbt AS INTEGER
DIM SHARED rcl, gcl, bcl, rltmp3(3), gltmp3(3), bltmp3(3), rtmp3(3), gtmp3(3), btmp3(3)
DIM SHARED rltmp4 AS INTEGER, gltmp4 AS INTEGER, bltmp4  AS INTEGER
DIM SHARED scrn(1 TO 320, 1 TO 200) AS INTEGER

strtbt = 3585
ext$ = ".wal"
ffile$ = "\wolf\vswap.wl1"

rtmp3(1) = 1
gtmp3(2) = 1
btmp3(3) = 1
rltmp3(1) = 1
gltmp3(2) = 1
bltmp3(3) = 1
        FOR tmp50 = 0 TO 255
          mtchc(tmp50) = -1
        NEXT

CONST hueradical = 2

aa = 1
loadpic 0
saved = 1
loadpalette
LOCATE 16, 1
COLOR 10
PRINT "?cdhijlmpqrsuvw"; CHR$(3); CHR$(24); CHR$(26); CHR$(25); CHR$(27)
DO
  LOCATE 10, 1
  PRINT "                        "
  COLOR 15
  DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
  SELECT CASE LCASE$(a$)
    CASE "?"
      help
    CASE "d"
      SCREEN 0
      WIDTH 80, 50
      SHELL
      SCREEN 13
      picture
      loadpalette
    CASE "p"
      picture
    CASE "l"
      loadfile ""
      saved = 0
    CASE "r"
      loadpic 1
      saved = 0
    CASE "m"
      multiply
      saved = 0
    CASE "s"
      save
    CASE "c"
      clrchng
      saved = 0
    CASE "i"
      inverse
      saved = 0
    CASE "u"
      LOCATE 10, 1
      PRINT a$
      loadfile file$
    CASE "v"
      LOCATE 10, 1
      PRINT a$
      vflip
      saved = 0
    CASE "h"
      LOCATE 10, 1
      PRINT a$
      hflip
      saved = 0
    CASE "j"
      IF saved = 0 THEN savepic
      LOCATE 10, 1
      LINE INPUT "? ", tmp110$
      aa = VAL(tmp110$)
      IF aa >= 1 THEN
        loadpic 0
        saved = 1
      END IF
    CASE CHR$(0) + "h", CHR$(0) + "m"
      IF saved = 0 THEN savepic
      IF aa < 60 THEN aa = aa + 1 ELSE aa = 1
      loadpic 0
      saved = 1
    CASE CHR$(0) + "p", CHR$(0) + "k"
      IF saved = 0 THEN savepic
      IF aa > 1 THEN aa = aa - 1 ELSE aa = 60
      loadpic 0
      saved = 1
    CASE "w"
      LOCATE 10, 3
      PRINT "W";
      IF saved = 0 THEN savepic
      IF strtbt = 3585 THEN ffile$ = "\spear\vswap.sdm": strtbt = 4097 ELSE strtbt = 3585: ffile$ = "\wolf\vswap.wl1"
      loadpic 0
      saved = 1
    CASE CHR$(27), "q", CHR$(3)
      IF saved = 0 THEN savepic
      GOTO nd
  END SELECT

LOOP

nd:
SCREEN 0
WIDTH 80, 25
COLOR INT(TIMER / 6170.4) + 1

      vain$ = "Richard A. Nichols III"
      LOCATE CSRLIN, 1
      l = TIMER
      FOR s = 1 TO LEN(vain$)
        LOCATE CSRLIN, 1
        PRINT RIGHT$(vain$, s) + STRING$(s * 2, 32);
        WHILE TIMER = l: WEND
        l = TIMER
      NEXT
      LOCATE CSRLIN, 1
      END

REM $STATIC
SUB clrchng
  LOCATE 10, 1
  COLOR match(63, 0, 0)
  LINE INPUT "R: ", a$
  IF a$ <> "" THEN
  rltmp3(1) = rtmp3(1)
  rltmp3(2) = rtmp3(2)
  rltmp3(3) = rtmp3(3)
    rtmp3(1) = npt(a$, 1)
    rtmp3(2) = npt(a$, 2)
    rtmp3(3) = npt(a$, 3)
  END IF
  LOCATE 10, 1
  PRINT "                                ";
  LOCATE , 1
  COLOR match(0, 63, 0)
  LINE INPUT "G: ", a$
  IF a$ <> "" THEN
  gltmp3(1) = gtmp3(1)
  gltmp3(2) = gtmp3(2)
  gltmp3(3) = gtmp3(3)
    gtmp3(1) = npt(a$, 1)
    gtmp3(2) = npt(a$, 2)
    gtmp3(3) = npt(a$, 3)
  END IF
  LOCATE 10, 1
  PRINT "                                ";
  LOCATE , 1
  COLOR match(0, 0, 63)
  LINE INPUT "B: ", a$
  IF a$ <> "" THEN
  bltmp3(1) = btmp3(1)
  bltmp3(2) = btmp3(2)
  bltmp3(3) = btmp3(3)
    btmp3(1) = npt(a$, 1)
    btmp3(2) = npt(a$, 2)
    btmp3(3) = npt(a$, 3)
  END IF

    LOCATE 16, 1
    PRINT "Working..."
    FOR tmp40 = 1 TO 3
      IF rtmp3(tmp40) <> rltmp3(tmp40) OR gtmp3(tmp40) <> gltmp3(tmp40) OR btmp3(tmp40) <> bltmp3(tmp40) THEN
        LINE (1, 129)-(256, 139), 0, BF
        FOR tmp50 = 0 TO 255
          mtchc(tmp50) = -1
        NEXT
        EXIT FOR
      END IF
    NEXT
    FOR tmp9r = 1 TO h
      FOR tmp9c = 1 TO w
        IF mtchc(pxl(tmp9c, tmp9r)) = -1 THEN
          mtchc(pxl(tmp9c, tmp9r)) = match(r(pxl(tmp9c, tmp9r)) * rtmp3(1) + g(pxl(tmp9c, tmp9r)) * gtmp3(1) + b(pxl(tmp9c, tmp9r)) * btmp3(1), r(pxl(tmp9c, tmp9r)) * rtmp3(2) + g(pxl(tmp9c, tmp9r)) * gtmp3(2) + b(pxl(tmp9c, tmp9r)) * btmp3(2), r( _
pxl(tmp9c, tmp9r)) * rtmp3(3) + g(pxl(tmp9c, tmp9r)) * gtmp3(3) + b(pxl(tmp9c, tmp9r)) * btmp3(3))
          LINE (pxl(tmp9c, tmp9r) + 1, 129)-(pxl(tmp9c, tmp9r) + 1, 139), mtchc(pxl(tmp9c, tmp9r))
        END IF
        pxl(tmp9c, tmp9r) = mtchc(pxl(tmp9c, tmp9r))
        PSET (tmp9c, tmp9r), pxl(tmp9c, tmp9r)
      NEXT
    NEXT
    LOCATE 16, 1
    PRINT "          "
END SUB

SUB help

GET (1, 1)-(320, 200), scrn
PRINT "jgjkgjkhg"
PUT (0, 0), scrn, PSET

END SUB

SUB hflip

FOR rowtmp = 1 TO h
  wcoltmp1 = w
  FOR coltmp = 1 TO w \ 2
    tmp = pxl(coltmp, rowtmp)
    pxl(coltmp, rowtmp) = pxl(wcoltmp1, rowtmp)
    PSET (coltmp, rowtmp), pxl(coltmp, rowtmp)
    pxl(wcoltmp1, rowtmp) = tmp
    PSET (wcoltmp1, rowtmp), pxl(wcoltmp1, rowtmp)
    wcoltmp1 = wcoltmp1 - 1
  NEXT
NEXT

END SUB

SUB inverse
 
LOCATE 10, 1
LINE INPUT "? ", tmp50$
IF tmp50$ = "" THEN tmp50$ = ltmp50$ ELSE ltmp50$ = tmp50$
rtmp4 = 0
gtmp4 = 0
btmp4 = 0
7
LOCATE 10, 3
FOR tmp51 = 1 TO LEN(tmp50$)
  SELECT CASE LCASE$(MID$(tmp50$, tmp51, 1))
    CASE "h": hflip
    CASE "v": vflip
    CASE "r": rtmp4 = 1: COLOR match(63, 0, 0)
    CASE "b": btmp4 = 1: COLOR match(0, 0, 63)
    CASE "g": gtmp4 = 1: COLOR match(0, 63, 0)
  END SELECT
  PRINT (MID$(tmp50$, tmp51, 1));
  COLOR 15
NEXT
IF tmp50$ = "" THEN tmp50$ = "rgb": GOTO 7
IF rtmp4 + btmp4 + gtmp4 = 0 THEN GOTO 8
IF rltmp4 <> rtmp4 OR gltmp4 <> gltmp4 OR bltmp4 <> bltmp4 THEN
  LINE (1, 162)-(256, 172), 0, BF
  FOR tmp53 = 0 TO 255
    inv(tmp53) = -1
  NEXT
END IF
rltmp4 = rtmp4
gltmp4 = gtmp4
bltmp4 = btmp4
FOR tmp52c = 1 TO w
  FOR tmp52r = 1 TO h
    IF rtmp4 = 1 THEN rtmp5 = 63 - r(pxl(tmp52c, tmp52r)) ELSE rtmp5 = r(pxl(tmp52c, tmp52r))
    IF gtmp4 = 1 THEN gtmp5 = 63 - g(pxl(tmp52c, tmp52r)) ELSE gtmp5 = g(pxl(tmp52c, tmp52r))
    IF btmp4 = 1 THEN btmp5 = 63 - b(pxl(tmp52c, tmp52r)) ELSE btmp5 = b(pxl(tmp52c, tmp52r))
    IF inv(pxl(tmp52c, tmp52r)) = -1 THEN
      inv(pxl(tmp52c, tmp52r)) = match(rtmp5, gtmp5, btmp5)
      LINE (pxl(tmp52c, tmp52r) + 1, 162)-(pxl(tmp52c, tmp52r) + 1, 172), inv(pxl(tmp52c, tmp52r))
    END IF
    pxl(tmp52c, tmp52r) = inv(pxl(tmp52c, tmp52r))
    PSET (tmp52c, tmp52r), pxl(tmp52c, tmp52r)
  NEXT
NEXT
8
END SUB

SUB loadfile (aa$)
IF aa$ <> "" THEN a$ = aa$: GOTO 3
1
LOCATE 10, 1
PRINT "                                      ";
LOCATE , 1
INPUT a$
IF a$ = "" THEN a$ = LTRIM$(RTRIM$(STR$(aa)))

3
IF INSTR(a$, ".") = 0 THEN a$ = a$ + ".wal"
file$ = UCASE$(a$)
OPEN file$ FOR BINARY AS #10
lof10 = LOF(10)
IF lof10 < 3 THEN
  BEEP
  CLOSE #10
  IF lof10 = 0 THEN KILL file$
  GOTO 30
END IF
LOCATE 12, 1
PRINT file$; "    "
w = ASC(INPUT$(1, #10))
h = ASC(INPUT$(1, #10))
LOCATE 14, 1
PRINT w; "X"; h

tmp1 = 0
FOR r = 1 TO h
  tmp80$ = INPUT$(w, #10)
  FOR c = 1 TO w
    pxl(c, r) = ASC(MID$(tmp80$, c, 1))
    PSET (c, r), pxl(c, r)
  NEXT
NEXT

CLOSE #10
30
END SUB

SUB loadpalette

    LOCATE 16, 1
    PRINT "Loading Palette..."
OPEN "\wolf\palette.bin" FOR BINARY AS #1
FOR s = 0 TO 255
  r(s) = ASC(INPUT$(1, 1))
  g(s) = ASC(INPUT$(1, 1))
  b(s) = ASC(INPUT$(1, 1))
  PALETTE s, r(s) + g(s) * 256 + b(s) * 65536
  LINE (s + 1, 140)-(s + 1, 150), s
NEXT
CLOSE #1

LOCATE 16, 1
PRINT "                               "

END SUB

SUB loadpic (tmp90)

LOCATE 10, 2
PRINT aa; "                        "
LOCATE 14, 1
PRINT " 64 x 64"
LOCATE 12, 1
PRINT aa; "                        "
h = 64
w = 64

IF tmp90 = 1 THEN tmp91$ = ".bak" ELSE tmp91$ = RIGHT$(ffile$, 4)
OPEN LEFT$(ffile$, LEN(ffile$) - 4) + tmp91$ FOR BINARY AS #15
SEEK #15, (aa - 1) * 64 ^ 2 + strtbt
FOR col = 1 TO 64
  tmp93$ = INPUT$(64, #15)
  FOR row = 1 TO 64
    pxl(col, row) = ASC(MID$(tmp93$, row, 1))
    PSET (col, row), pxl(col, row)
  NEXT
NEXT
CLOSE #15
LOCATE 10, 3
PRINT "  "

END SUB

FUNCTION match (rtmp, gtmp, btmp)

tmp3 = 0
tmp5 = ABS(rtmp - r(tmp3)) ^ hueradical + ABS(gtmp - g(tmp3)) ^ hueradical + ABS(btmp - b(tmp3)) ^ hueradical
FOR tmp3 = 0 TO 255
  tmp4 = (rtmp - r(tmp3)) ^ 2 + (gtmp - g(tmp3)) ^ 2 + (btmp - b(tmp3)) ^ 2
  IF tmp4 < tmp5 THEN tmp5 = tmp4: tmp6 = tmp3
NEXT
match = tmp6

END FUNCTION

SUB multiply
   
    LOCATE 10, 1
    PRINT "                       ";
    LOCATE , 1
    LINE INPUT "? ", a$
    IF a$ = "" THEN
      rtmp2 = rcl
      gtmp2 = gcl
      btmp2 = bcl
    ELSE
     
      rcl = rtmp2
      gcl = gtmp2
      bcl = btmp2
     
      rtmp2 = npt(a$, 1)
      gtmp2 = npt(a$, 2)
      btmp2 = npt(a$, 3)

    END IF
    LOCATE 10, 3
    COLOR match(63, 0, 0): PRINT RTRIM$(LTRIM$(STR$(rtmp2))); : COLOR 7: PRINT ","; : COLOR match(0, 63, 0): PRINT RTRIM$(STR$(gtmp2)); : COLOR 7: PRINT ","; : COLOR match(0, 0, 63): PRINT RTRIM$(STR$(btmp2))
    LOCATE 16, 1
    PRINT "Working..."
    IF rtmp2 <> rcl OR gtmp2 <> gcl OR btmp2 <> bcl THEN
      rcl = rtmp2
      gcl = gtmp2
      bcl = btmp2
      FOR tmp16 = 0 TO 255
        mtch(tmp16) = -1
      NEXT
      LINE (1, 151)-(256, 161), 0, BF
    END IF
    FOR tmp9r = 1 TO h
      FOR tmp9c = 1 TO w
        IF mtch(pxl(tmp9c, tmp9r)) = -1 THEN
          mtch(pxl(tmp9c, tmp9r)) = match(r(pxl(tmp9c, tmp9r)) * rtmp2, g(pxl(tmp9c, tmp9r)) * gtmp2, b(pxl(tmp9c, tmp9r)) * btmp2)
          LINE (pxl(tmp9c, tmp9r) + 1, 151)-(pxl(tmp9c, tmp9r) + 1, 161), mtch(pxl(tmp9c, tmp9r))
        END IF
        pxl(tmp9c, tmp9r) = mtch(pxl(tmp9c, tmp9r))
        PSET (tmp9c, tmp9r), pxl(tmp9c, tmp9r)
      NEXT
    NEXT
    LOCATE 16, 1
    PRINT "          "


END SUB

FUNCTION npt (a$, tmp25)
      tmp21 = 1
      REDIM tmp22$(3)
      tmp20$ = ""
      FOR tmp19 = 1 TO LEN(a$)
        lt$ = tmp20$
        tmp20$ = MID$(a$, tmp19, 1)
        IF tmp20$ = " " THEN
          IF lt$ <> " " AND lt$ <> "," THEN tmp21 = tmp21 + 1
        ELSE
          IF tmp20$ = "," THEN
            tmp21 = tmp21 + 1
          ELSE
            tmp22$(tmp21) = tmp22$(tmp21) + tmp20$
          END IF
        END IF
      NEXT
npt = VAL(tmp22$(tmp25))
END FUNCTION

SUB picture
 
FOR r = 1 TO h
  FOR c = 1 TO w
    PSET (c, r), pxl(c, r)
  NEXT
NEXT

END SUB

SUB save
 
12
LOCATE 10, 1
PRINT "                    ";
LOCATE , 1
INPUT a$
IF a$ = "" THEN a$ = LTRIM$(RTRIM$(STR$(aa)))

IF INSTR(a$, ".") = 0 THEN a$ = a$ + ext$ ELSE ext$ = RIGHT$(a$, LEN(a$) - INSTR(a$, ".") + 1)

LOCATE 16, 1
PRINT "Working..."

LOCATE 10, 3
file$ = UCASE$(a$)
PRINT file$
OPEN file$ FOR OUTPUT AS #10
PRINT #10, CHR$(w); CHR$(h);
FOR tmp12r = 1 TO h
  FOR tmp12c = 1 TO w
    PRINT #10, CHR$(pxl(tmp12c, tmp12r));
  NEXT
NEXT
LOCATE 16, 1
PRINT "            "
CLOSE #10

END SUB

SUB savepic


OPEN ffile$ FOR BINARY AS #16
SEEK #16, (aa - 1) * 64 ^ 2 + strtbt
FOR col = 1 TO 64
  FOR row = 1 TO 64
    tmp130$ = CHR$(pxl(col, row))
    PUT #16, , tmp130$
  NEXT
NEXT
CLOSE #16

END SUB

SUB vflip

FOR coltmp = 1 TO w
  hrowtmp1 = h
  FOR rowtmp = 1 TO h \ 2
    tmp = pxl(coltmp, rowtmp)
    pxl(coltmp, rowtmp) = pxl(coltmp, hrowtmp1)
    PSET (coltmp, rowtmp), pxl(coltmp, rowtmp)
    pxl(coltmp, hrowtmp1) = tmp
    PSET (coltmp, hrowtmp1), pxl(coltmp, hrowtmp1)
    hrowtmp1 = hrowtmp1 - 1
  NEXT
NEXT

END SUB