/* $VER: padCanvas.ifx 2.08 July.30.1996 06:35:30
 *
 * Copyright ©1996 Enosis C. S., All Rights Reserved.
 * Written by Ola Eric Olsson
 *
 *
 */


/*
 * v2.08
 * 1) -- Added check routines for libraries and ancillary programs
 *
 */

/*
 * v2.04
 * 1) -- Fixed bug that crashed the script if you select
 *       "lastX" or "lastY" as the first choice
 */

/*
 * v2.02
 * 1) -- Added busy bar to lockout gui when processing
 */

/*
 *    v2.00
 * 1) -- Changed Cancel to Quit
 * 2) -- Now runs refresh when selecting accept
 */

$$VERSION = 2.08

rx "address command 'version imagefx:imagefx > ram:ver'"
IF OPEN("VER",'ram:ver','R') THEN
DO
   line = READLN("VER")
   IF LEFT(WORD(line,2),3) ~= '2.6' THEN
   DO
      CALL CLOSE("VER")
      ADDRESS COMMAND "delete ram:ver"
      ADDRESS IMAGEFX.1
      RequestNotify "You must have ImageFX 2.6!"
      EXIT
   END
   ELSE
   DO
      CALL CLOSE("VER")
      ADDRESS COMMAND "delete ram:ver"
   END
END

/******************************************************************/
/** CHECK VERSIONS OF LIBRARIES AND SUPPORT PROGRAMS             **/
/******************************************************************/

libs.1 = 'rexxsupport.library'
libs.2 = 'rexxarplib.library'
libs.3 = 'rexxmathlib.library'
libs.4 = 'rexxtricks.library'
libs.5 = 'arp.library'

errArr. = ''
err = 0
libErr = 0

ADDRESS IMAGEFX.1

DO i = 1 to 4
   library = EXISTS("libs:"||libs.i)
   IF library = 1 THEN
   DO
      ADDRESS COMMAND "version "||libs.i||" > T:libV"
      IF OPEN('INFILE','T:libV',R) THEN
      DO
         version = READLN('INFILE')
         CLOSE('INFILE')

         SELECT

            WHEN i = 1 THEN
            DO
               IF WORD(version,2) < "34.9" THEN
               DO
                  err = 1
                  libErr = libErr + 1
                  errArr.1 = "Need version rexxsupport.library 34.9"
               END
            END

            WHEN i = 2 THEN
            DO
               IF WORD(version,2) < "3.3" THEN
               DO
                  err = 1
                  libErr = libErr + 1
                  errArr.2 = "Need version rexxarplib.library   3.3"
               END
            END

            WHEN i = 3 THEN
            DO
               IF WORD(version,2) < "38.1" THEN
               DO
                  err = 1
                  libErr = libErr + 1
                  errArr.3 = "Need version rexxmathlib.library 38.1"
               END
            END

            WHEN i = 4 THEN
            DO
               IF WORD(version,2) < "38.6" THEN
               DO
                  err = 1
                  libErr = libErr + 1
                  errArr.4 = "Need version rexxtricks.library  38.6"
               END
            END

            WHEN i = 5 THEN
            DO
               IF WORD(version,2) < "39.1" THEN
               DO
                  err = 1
                  libErr = libErr + 1
                  errArr.4 = "Need version arp.library  39.1"
               END
            END
         END
      END

      IF err = 0 THEN
      DO
         IF ~SHOW('L',libs.i) THEN CALL ADDLIB(libs.i,0,-30,0)
         IF ~SHOW('L',libs.i) THEN
         DO
            message = "Can't load "||libs.i
            requestnotify message
            CALL exit_msg()
         END
      END
   END
   ELSE
   DO
      message = "Can't find "||libs.i
      requestnotify message
      CALL exit_msg()
   END
END

app.1 = "imagefx:rexx/Pc_colorSelector.ifx"

IF EXISTS( app.1 ) THEN
DO
   ADDRESS COMMAND "version "||app.1||" > T:libV"
   IF OPEN('INFILE','T:libV',R) THEN
   DO
      version = READLN('INFILE')
      CLOSE('INFILE')

      IF WORD(version,2) < "1.02" THEN
      DO
         libErr = libErr + 1
         errArr.liberr = "Need version Pc_colorselector.ifx 1.02"
      END
   END
END
ELSE
DO
   liberr = liberr + 1
   errArr.liberr = "Missing 'imagefx:rexx/Pc_colorSelector.ifx'"
END

IF liberr > 0 THEN
DO
   text.1 = 'TEXT 20 5 50 14 "There is a problem with libraries,"'
   text.2 = 'TEXT 20 15 50 14 "and/or supplementary applications!"'
   text.3 = 'TEXT 20 25 50 14 "Libraries must be in libs:"'
   text.4 = 'TEXT 20 35 50 14 "Applications must be in imagefx:rexx/"'

   DO i = 1 to liberr
      node = i+4
      pos = 35 + (i * 10)
      text.node = 'TEXT 20 '||pos||' 50 14 "'||errArr.i||'"'
   END

   hgt = pos + 20
   NewComplexRequest '"Missing or Wrong Files!"' text 330 hgt

   EXIT
END

screen = "IMAGEFX_SCREEN"
script_path = "ImageFX:rexx/ext_tools/"

swapX = 0
swapY = 0
swapStat = 0
rval   = 0
gval   = 0
bval   = 0
tlStat = 0
tcStat = 0
trStat = 0
clStat = 0
ccStat = 1
status = 5
crStat = 0
blStat = 0
bcStat = 0
brStat = 0

OPTIONS RESULTS
/*TRACE COMMANDS*/

/*
 * Set Up ImageFX
 */

ADDRESS IMAGEFX.1

BeginBar 'Loading' 1
LockGui

CALL getInfo

testport = openport(PADPORT)
IF testport = 0 THEN
DO
   CALL postmsg(10,10,"Couldn't open PADPORT, am exiting.")
   CALL DELAY(80)
   CALL postmsg()
   EXIT 5
END

ADDRESS AREXX "'CALL createhost(PADHOST,PADPORT,"||screen||")'"

DO i = 1 to 6
   IF ~SHOWLIST('p',PADHOST) THEN CALL DELAY(60)
   ELSE LEAVE i
end

IF i = 10 & ~SHOWLIST('p',PADHOST) THEN
DO
   CALL postmsg(10,10,"Couldn't open HOST, am exiting")
   CALL DELAY(80)
   CALL postmsg()
   EXIT 5
END

CALL makewindow()

UnLockGui
EndBar
redraw off

quitflag = 0
DO forever
   IF quitflag = 1 THEN LEAVE
   t = WAITPKT(PADPORT)
   DO ff = 1
      p = getpkt(PADPORT)
      IF c2d(p) = 0 THEN LEAVE ff
      command = GETARG(p)
      t = REPLY(p,0)

      SELECT
         WHEN command = 'CLOSEWINDOW' THEN
         DO
            CALL postmsg()
            CALL CloseWindow(PADHOST)
            quitflag = 1
            IF EXISTS("ram:rgb.dat") THEN ADDRESS COMMAND "delete ram:rgb.dat"
            redraw on
         END

         WHEN command = 'ACCEPT' THEN
         DO
            BeginBar 'Processing' 4
            Bar 0
            Bar 1
            LockGui
            CALL checkRoll
            UnlockGui;Bar 2;LockGui
            CALL setRoll
            UnlockGui;Bar 3;LockGui
            Redraw
            UnlockGui;Bar 4;LockGui
            CALL getInfo('refresh')
            UnLockGui
            EndBar
         END

         WHEN command = 'REFRESH' THEN
         DO
            CALL getInfo('refresh')
         END

         WHEN command = 'QUIT' THEN
         DO
            CALL postmsg()
            CALL CloseWindow(PADHOST)
            quitflag = 1
            IF EXISTS("ram:rgb.dat") THEN ADDRESS COMMAND "delete ram:rgb.dat"
            redraw on
         END

         WHEN command = 'WID' THEN
         DO
            lastX = newWidth
            newWidth = GetVar(PADHOST,PADPORT,'WID')

            IF newWidth < width THEN
            DO
               msg = "Cropping is not allowed!"
               CALL PostMsg(100,100,msg,screen)
               CALL DELAY(150)
               CALL PostMsg()

               newWidth = lastX
               lastX    = newWidth
               CALL RemoveGadget(PADHOST,"WID")
               CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)
            END
         END

         WHEN command = 'HGT' THEN
         DO
            lastY = newHeight
            newHeight = GetVar(PADHOST,PADPORT,'HGT')

            IF newHeight < height THEN
            DO
               msg = "Cropping is not allowed!"
               CALL PostMsg(100,100,msg,screen)
               CALL DELAY(150)
               CALL PostMsg()

               newHeight = lastY
               lastY     = newHeight
               CALL RemoveGadget(PADHOST,"HGT")
               CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)
            END
         END

         WHEN command = 'X15' THEN
         DO
            lastX = newWidth
            newWidth = TRUNC(newWidth * 1.5)
            CALL RemoveGadget(PADHOST,"WID")
            CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)
         END

         WHEN command = 'X20' THEN
         DO
            lastX = newWidth
            newWidth = TRUNC(newWidth * 2.0)
            CALL RemoveGadget(PADHOST,"WID")
            CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)
         END

         WHEN command = 'XSWAP' THEN
         DO
            IF swapStat = 1 THEN
            DO
               IF swWidth < newWidth THEN
               DO
                  msg = "Swap width is less than current!"
                  CALL PostMsg(100,100,msg,screen)
                  CALL DELAY(200)
                  CALL PostMsg()
               END
               ELSE
               DO
                  lastX = newWidth
                  newWidth = swWidth
                  CALL RemoveGadget(PADHOST,"WID")
                  CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)
               END
            END
            ELSE
            DO
               msg = "No swap buffer!"
               CALL PostMsg(100,100,msg,screen)
               CALL DELAY(200)
               CALL PostMsg()
            END
         END

         WHEN command = 'XLAST' THEN
         DO
            IF (lastX ~= '') THEN
            DO
               newWidth = lastX
               CALL RemoveGadget(PADHOST,"WID")
               CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)
            END
         END

         WHEN command = 'Y15' THEN
         DO
            lastY = newHeight
            newHeight = TRUNC(newHeight * 1.5)
            CALL RemoveGadget(PADHOST,"HGT")
            CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)
         END

         WHEN command = 'Y20' THEN
         DO
            lastY = newHeight
            newHeight = TRUNC(newHeight * 2.0)
            CALL RemoveGadget(PADHOST,"HGT")
            CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)
         END

         WHEN command = 'YSWAP' THEN
         DO
            IF swapStat = 1 THEN
            DO
               IF swHeight < newHeight THEN
               DO
                  msg = "Swap height is less than current!"
                  CALL PostMsg(100,100,msg,screen)
                  CALL DELAY(200)
                  CALL PostMsg()
               END
               ELSE
               DO
                  lastY = newHeight
                  newHeight = swHeight
                  CALL RemoveGadget(PADHOST,"HGT")
                  CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)
               END
            END
            ELSE
            DO
               msg = "No swap buffer!"
               CALL PostMsg(100,100,msg,screen)
               CALL DELAY(200)
               CALL PostMsg()
            END
         END

         WHEN command = 'YLAST' THEN
         DO
            IF (lastY ~= '') THEN
            DO
               newHeight = lastY
               CALL RemoveGadget(PADHOST,"HGT")
               CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)
            END
         END

         WHEN command = 'TOPLEFT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'TOPLEFT',on)
            tlStat = 1
            status = 1
         END

         WHEN command = 'TOPCENTER' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'TOPCENTER',on)
            tcStat = 1
            status = 2
         END

         WHEN command = 'TOPRIGHT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'TOPRIGHT',on)
            trStat = 1
            status = 3
         END

         WHEN command = 'CENTERLEFT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'CENTERLEFT',on)
            clStat = 1
            status = 4
         END

         WHEN command = 'CENTER' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'CENTER',on)
            ccStat = 1
            status = 5
         END

         WHEN command = 'CENTERRIGHT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'CENTERRIGHT',on)
            crStat = 1
            status = 6
         END

         WHEN command = 'BOTTOMLEFT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'BOTTOMLEFT',on)
            blStat = 1
            status = 7
         END

         WHEN command = 'BOTTOMCENTER' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'BOTTOMCENTER',on)
            bcStat = 1
            status = 8
         END

         WHEN command = 'BOTTOMRIGHT' THEN
         DO
            CALL posOFF
            CALL SetGadget(PADHOST,'BOTTOMRIGHT',on)
            brStat = 1
            status = 9
         END

         WHEN command = 'SETRGB' THEN
         DO
            ADDRESS COMMAND "run > NIL: rx "||script_path||"Pc_colorSelector.ifx"

            CALL DELAY(200)

            DO FOREVER
               IF ~SHOWLIST('p',RGBPORT) THEN LEAVE
               CALL DELAY(30)
               /* SAY 'looped' */
            END

            IF OPEN('COLOR','ram:rgb.dat','r') THEN
            DO
               rgbColor = READLN('COLOR')
               CALL CLOSE('COLOR')

               PARSE VAR rgbColor rNil ' ' gNil ' ' bNil ' ' rval ' ' gval ' ' bval
               /* ADDRESS IMAGEFX.1 setpalette '-1' rv gv bv */

               CALL Move(PADHOST, r4x + 85 , l11y)
               CALL SetAPen(PADHOST,2)
               CALL Text(PADHOST,RIGHT(rval,3,'0')||" "||RIGHT(gval,3,'0')||" "||RIGHT(bval,3,'0'))

               /*  ADDRESS COMMAND "delete ram:rgb.dat" */

            END
         END

         OTHERWISE NOP
      END
   END
END

EXIT

/******************************************************************/
/** Retrieves Contents of String Gadgets                         **/
/******************************************************************/

GetVar:
   PARSE ARG PADHOST, PADPORT, gadgetname
   CALL ReadGadget(PADHOST,gadgetname)
   t = waitpkt(PADPORT)
   p = getpkt(PADPORT)
   string = getarg(p,1)
   t = reply(p,0)
   string = strip(string)
RETURN string

/******************************************************************/
/** Create the window.                                           **/
/******************************************************************/

makewindow:

   idcmp = 'CLOSEWINDOW+GADGETUP+MENUPICK'
   flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH'

   title = "PadCANVAS "||$$VERSION

   CALL OpenWindow(PADHOST,0,0,300,320,idcmp,flags,title)

   /*************  Pad Size Box  ********************/

   DO
      r1x=10; r1y=15; r1w=280; r1h=60; r1th=1

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,r1x,r1y)
      CALL Draw(PADHOST,(r1x+r1w),r1y)
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,(r1x+r1w),(r1y+r1h))
      CALL Draw(PADHOST,r1x,(r1y+r1h))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,r1x,r1y)

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,(r1x+r1th),(r1y+r1th))
      CALL Draw(PADHOST,((r1x+r1w)-r1th),(r1y+r1th))
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,((r1x+r1w)-r1th),((r1y+r1h)-r1th))
      CALL Draw(PADHOST,(r1x+r1th),((r1y+r1h)-r1th))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,(r1x+r1th),(r1y+r1th))

      l1y = r1y + 15

      CALL Move(PADHOST, r1x + 115 , l1y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, "PAD SIZE")

      l2y = r1y + 30

      CALL Move(PADHOST, r1x + 10 , l2y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "Width:")

      CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)

      CALL Move(PADHOST, r1x + 154 , l2y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "Height:")

      CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)

      l3y = r1y + 45

      CALL Move(PADHOST, r1x + 10 , l3y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "Current Swap Size:")

      CALL Move(PADHOST, r1x + 180 , l3y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, swapX||" x "||swapY)
   END

   /*************  Quick Set Box  ********************/

   DO
      r2x=r1x; r2y=r1y+65; r2w=280; r2h=60; r2th=1

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,r2x,r2y)
      CALL Draw(PADHOST,(r2x+r2w),r2y)
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,(r2x+r2w),(r2y+r2h))
      CALL Draw(PADHOST,r2x,(r2y+r2h))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,r2x,r2y)

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,(r2x+r2th),(r2y+r2th))
      CALL Draw(PADHOST,((r2x+r2w)-r2th),(r2y+r2th))
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,((r2x+r2w)-r2th),((r2y+r2h)-r2th))
      CALL Draw(PADHOST,(r2x+r2th),((r2y+r2h)-r2th))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,(r2x+r2th),(r2y+r2th))

      l3by = r2y + 15

      CALL Move(PADHOST, r2x + 111 , l3by)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, "QUICK SET")

      l4y = r2y + 30

      CALL Move(PADHOST, r2x + 10 , l4y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "X ->")

      CALL AddGadget(PADHOST, r2x+55,l4y - 6,"X15","1.5","%d")
      CALL AddGadget(PADHOST, r2x+95,l4y - 6,"X20","2.0","%d")
      CALL AddGadget(PADHOST, r2x+135,l4y - 6,"XSWAP","Match Swap","%d")
      CALL AddGadget(PADHOST, r2x+230,l4y - 6,"XLAST","Last","%d")

      l5y = r2y + 45

      CALL Move(PADHOST, r2x + 10 , l5y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "Y ->")

      CALL AddGadget(PADHOST, r2x+55,l5y - 6,"Y15","1.5","%d")
      CALL AddGadget(PADHOST, r2x+95,l5y - 6,"Y20","2.0","%d")
      CALL AddGadget(PADHOST, r2x+135,l5y - 6,"YSWAP","Match Swap","%d")
      CALL AddGadget(PADHOST, r2x+230,l5y - 6,"YLAST","Last","%d")
   END

   /*************  Positioning Gadgets  ********************/

   DO
      r3x=r1x; r3y=r2y+65; r3w=280; r3h=90; r3th=1

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,r3x,r3y)
      CALL Draw(PADHOST,(r3x+r3w),r3y)
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,(r3x+r3w),(r3y+r3h))
      CALL Draw(PADHOST,r3x,(r3y+r3h))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,r3x,r3y)

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,(r3x+r3th),(r3y+r3th))
      CALL Draw(PADHOST,((r3x+r3w)-r3th),(r3y+r3th))
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,((r3x+r3w)-r3th),((r3y+r3h)-r3th))
      CALL Draw(PADHOST,(r3x+r3th),((r3y+r3h)-r3th))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,(r3x+r3th),(r3y+r3th))

      l6y = r3y + 15

      CALL Move(PADHOST, r3x + 80 , l6y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, "POSITION ORIGINAL")

      l7y = l6y + 20

      CALL AddGadget(PADHOST, r3x+12,    l7y - 6,"TOPLEFT"  ,"Top Lft"   ,"%d")
      CALL AddGadget(PADHOST, r3x+108, l7y - 6,"TOPCENTER","Top Cen" ,"%d")
      CALL AddGadget(PADHOST, r3x+207,l7y - 6,"TOPRIGHT" ,"Top Rgt"  ,"%d")

      l8y = l7y + 20

      CALL AddGadget(PADHOST, r3x+12,    l8y - 6,"CENTERLEFT"  ,"Cen Lft"   ,"%d")
      CALL AddGadget(PADHOST, r3x+108, l8y - 6,"CENTER","Center " ,"%d")
      CALL SetGadget(PADHOST,CENTER,on)
      CALL AddGadget(PADHOST, r3x+207,l8y - 6,"CENTERRIGHT" ,"Cen Rgt"  ,"%d")

      l9y = l8y + 20

      CALL AddGadget(PADHOST, r3x+12,    l9y - 6,"BOTTOMLEFT"  ,"Bot Lft"   ,"%d")
      CALL AddGadget(PADHOST, r3x+108, l9y - 6,"BOTTOMCENTER","Bot Cen" ,"%d")
      CALL AddGadget(PADHOST, r3x+207,l9y - 6,"BOTTOMRIGHT" ,"Bot Rgt"  ,"%d")
   END

   /*************  Background Color Box  ********************/

   DO
      r4x=r1x; r4y=r3y+95; r4w=280; r4h=40; r4th=1

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,r4x,r4y)
      CALL Draw(PADHOST,(r4x+r4w),r4y)
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,(r4x+r4w),(r4y+r4h))
      CALL Draw(PADHOST,r4x,(r4y+r4h))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,r4x,r4y)

      CALL SetAPen(PADHOST,2)
      CALL Move(PADHOST,(r4x+r4th),(r4y+r4th))
      CALL Draw(PADHOST,((r4x+r4w)-r4th),(r4y+r4th))
      CALL SetAPen(PADHOST,1)
      CALL Draw(PADHOST,((r4x+r4w)-r4th),((r4y+r4h)-r4th))
      CALL Draw(PADHOST,(r4x+r4th),((r4y+r4h)-r4th))
      CALL SetAPen(PADHOST,2)
      CALL Draw(PADHOST,(r4x+r4th),(r4y+r4th))

      l10y = r4y + 15

      CALL Move(PADHOST, r4x + 80 , l10y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, "BACKGROUND COLOR")

      l11y = r4y + 30

      CALL Move(PADHOST, r4x + 10 , l11y)
      CALL SetAPen(PADHOST,1)
      CALL Text(PADHOST, "Current:")

      CALL Move(PADHOST, r4x + 85 , l11y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, RIGHT(rval,3,'0')||" "||RIGHT(gval,3,'0')||" "||RIGHT(bval,3,'0'))

      CALL AddGadget(PADHOST, r4x+207,l11y - 6,"SETRGB","Set RGB","%d")

   END

   l12y = r4y + 60

   CALL AddGadget(PADHOST, r4x+25,l12y - 6,"ACCEPT" ," ACCEPT ","%d")
   CALL AddGadget(PADHOST, r4x+105,l12y - 6,"REFRESH" ," REFRESH ","%d")
   CALL AddGadget(PADHOST, r4x+190,l12y - 6,"QUIT"," QUIT ","%d")

RETURN /* END CREATE WINDOW */

/******************************************************************/
/** Turn off all position gadgets                                **/
/******************************************************************/

posOff:

   CALL SetGadget(PADHOST,TOPLEFT,off)
   CALL SetGadget(PADHOST,TOPCENTER,off)
   CALL SetGadget(PADHOST,TOPRIGHT,off)
   CALL SetGadget(PADHOST,CENTERLEFT,off)
   CALL SetGadget(PADHOST,CENTER,off)
   CALL SetGadget(PADHOST,CENTERRIGHT,off)
   CALL SetGadget(PADHOST,BOTTOMLEFT,off)
   CALL SetGadget(PADHOST,BOTTOMCENTER,off)
   CALL SetGadget(PADHOST,BOTTOMRIGHT,off)

   tlStat = 0
   tcStat = 0
   trStat = 0
   clStat = 0
   ccStat = 0
   crStat = 0
   blStat = 0
   bcStat = 0
   brStat = 0

RETURN  /* END posOff */

/******************************************************************/
/** Check for cropping and make adjustments as necessary.        **/
/******************************************************************/

checkRoll:

   rollx_bool = 1
   rolly_bool = 1
   cropx_bool = 0
   cropy_bool = 0

   IF newWidth < width | newHeight < height THEN
   DO
      msg = "CLIPPING IS NOT ALLOWED!"
      CALL PostMsg(100,100,msg,screen)
      CALL DELAY(150)
      CALL PostMsg()
   END

   IF newWidth > width | newHeight > height THEN
   DO
      scale newWidth newHeight border

      floodX1 = 1
      floodY1 = 1
      floodX2 = newWidth - 1
      floodY2 = newHeight - 1

      SetPalette '-1' rval gval bval
      FloodFill floodX1 floodY1 1

      IF newWidth = width | newHeight = height THEN
      DO
         FloodFill floodX2 floodY2 1
      END
   END

RETURN

/******************************************************************/
/** Roll the image.                                              **/
/******************************************************************/

setRoll:

   IF status = 1 THEN
   DO
         /* Image rolls left and up */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) /*-((newWidth-width)//2>0)*/
      ELSE rollx = 0

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2) /*-((newHeight-height)//2>0)*/
      ELSE rolly = 0

      CALL ROLL_IT('-','-',rolly,rollx)

      RETURN
   END

   IF status = 2 THEN
   DO
         /* Image rolls up */

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2) /*+((newHeight-height)//2>0)*/
      ELSE rolly = 0

      CALL ROLL_IT('-','+',rolly,'0')

      RETURN
   END

   IF status = 3 THEN
   DO
         /* Image rolls right and up */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) + ((newWidth-width)//2 > 0)
      ELSE rollx = 0

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2) /*+((newHeight-height)//2>0))*/
      ELSE rolly = 0

      CALL ROLL_IT('-','+',rolly,rollx)

      RETURN
   END

   IF status = 4 THEN
   DO
         /* Image rolls left */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) /*+((newWidth-width)//2 > 0)*/
      ELSE rollx = 0

      CALL ROLL_IT('+','-','0',rollx)

      RETURN
   END

   IF status = 5 THEN
   DO
      RETURN
   END

   IF status = 6 THEN
   DO
         /* Image rolls right */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) + ((newWidth-width)//2 > 0)
      ELSE rollx = 0

      CALL ROLL_IT('+','+','0',rollx)

      RETURN
   END

   IF status = 7 THEN
   DO
         /* Image rolls left and down */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) /*+((newWidth-width)//2>0)*/
      ELSE rollx = 0

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2)+((newHeight-height)//2 > 0)
      ELSE rolly = 0

      CALL ROLL_IT('+','-',rolly,rollx)

      RETURN
   END

   IF status = 8 THEN
   DO
         /* Image rolls down */

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2)+((newHeight-height)//2 > 0)
      ELSE rolly = 0

      CALL ROLL_IT('+','+',rolly,'0')

      RETURN
   END

   IF status = 9 THEN
   DO
         /* Image rolls right and down */
      IF rollx_bool = 1 THEN rollx = TRUNC((newWidth-width)/2) + ((newWidth-width)//2 > 0)
      ELSE rollx = 0

      IF rolly_bool = 1 THEN rolly = TRUNC((newHeight-height)/2) + ((newHeight-height)//2 > 0)
      ELSE rolly = 0

      CALL ROLL_IT('+','+',rolly,rollx)

      RETURN
   END

RETURN

/******************************************************************/
/** Rolls the swap buffer                                        **/
/******************************************************************/

ROLL_IT:

   PARSE ARG ysign,xsign,rolly,rollx

   roll xsign||rollx ysign||rolly

RETURN

/******************************************************************/
/** Get Current Image Info                                       **/
/******************************************************************/

getInfo:

   PARSE ARG caller

   /* Check for loaded image */
   getmain

   IF rc ~= 0 THEN
   DO
      RequestNotify "No image Loaded!"
      CALL abort
   END

   PARSE VAR RESULT name width height .

   newWidth  = width
   newHeight = height

   /* Check for loaded image */
   getswap

   IF rc = 0 THEN
   DO
      PARSE VAR RESULT name swWidth swHeight .
      swapStat = 1
      swapX = swWidth
      swapY = swHeight
   END

   IF caller = 'refresh' THEN
   DO
      newWidth = width
      lastX    = newWidth
      CALL RemoveGadget(PADHOST,"WID")
      CALL AddGadget(PADHOST, r1x+65,l2y - 6,"WID",newWidth,"%d%1%g",50,RIDGEBORDER)

      newHeight = height
      lastY     = newHeight
      CALL RemoveGadget(PADHOST,"HGT")
      CALL AddGadget(PADHOST, r1x+217,l2y - 6,"HGT",newHeight,"%d%1%g",50,RIDGEBORDER)

      CALL Move(PADHOST, r1x + 180 , l3y)
      CALL SetAPen(PADHOST,2)
      CALL Text(PADHOST, swapX||" x "||swapY)
   END
   ELSE
   DO
      lastX = newWidth
      lasty = newHeight
   END

RETURN

/******************************************************************/
/** Exits Gracefully.                                            **/
/******************************************************************/

abort:

/* Closing arguments here */


/*unlockgui*/
redraw on


EXIT