home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-04-16 | 44.2 KB | 1,955 lines |
- /*
- ** A D P r o T o o l b o x
- **
- ** Version 4.10
- **
- ** This ARexx program is a Format Converter and effect generator.
- ** Requires ADPro V2.3.0 for some new features
- This Program is Shareware
- Last changes: 15.4.1994
-
- **
- ** ------------------------------------------------
- ** | This AREXX script was written by |
- ** | Andreas Seebacher of |
- ** | BitART design |
- ** | Debugging help by |
- ** | Martin Moser |
- ** | Some useful ideas by Armin Kleinschmidt |
- ** | (c) 1993-94 |
- ** ------------------------------------------------
- */
-
- /*
- Make sure the needed libraries are available, and away we go!
- */
-
- IF ~SHOW('L','rexxsupport.library') THEN
- CALL ADDLIB('rexxsupport.library',0,-30,0)
- IF ~SHOW('L','rexxarplib.library') THEN
- CALL ADDLIB('rexxarplib.library',0,-30,0)
-
- ADDRESS "ADPro"
- OPTIONS RESULTS
- NL = '0A'X
-
- ADPRO_TO_BACK
-
- /*
- Find a free hostport.
- */
-
- host='TOOLBOXHOST'
- port='TOOLBOXPORT'
- IF replyport='' THEN
- DO
- DO i=1 WHILE SHOW('P',host||i)
- END
- host=host||i
- port=port||i
- END
- ELSE
- DO
- host=host'.'replyport
- port=port'.'replyport
- IF SHOW('P',port) THEN
- DO
- INTERPRET ADDRESS port FRONT
- EXIT(0)
- END
- END
-
- /*
- We need a HOST to set up our window in
- */
-
- CALL setup_host()
-
- CALL setup_variables()
-
- w.=''
- w.idcmp='CLOSEWINDOW+MENUPICK+GADGETUP+MOUSEBUTTONS'
- w.flags='WINDOWCLOSE+WINDOWDRAG'
-
-
- w.title='ADPro-ToolBOX V4.10 (c) BitART design 1994'
- IF replyport~='' THEN w.title='ADPro-ToolBOX V4.10 (c) BitART design 1994'
-
- pscreen='Workbench'
- xmax=410
- ymax=165
- CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
- (ScreenRows(pscreen)-ymax)%2, ,
- xmax,ymax,w.idcmp,w.flags,w.title)
-
- /*
- Make sure our text images will be correct, no matter what...
- */
-
- CALL SetFont(host,'topaz.font',8)
-
- CALL SetAPen(host,1)
-
- /*
- Setting up our main menus...
- */
-
- CALL AddMenu(host,'Project')
- CALL AddItem(host,'Start Converting','OK','S')
- CALL AddItem(host,'-------------------','DUMMY')
- CALL AddItem(host,'Save Preferences...','SAVEPREFS','P')
- CALL AddItem(host,'-------------------','DUMMY')
- CALL AddItem(host,'Quit ','CLOSEWINDOW','Q')
-
- CALL AddMenu(host,'Prefs')
- CALL AddItem(host,'First pic palette','PALETTE')
- CALL AddSubItem(host,' Palette locked','PLOCKED','L',-1)
- CALL AddSubItem(host,' Palette unlocked','PUNLOCKED','U',-1)
-
- if LockedItemFlag=1 then do
- CALL SetItem(host,1,0,LockedItemFlag,ON)
- PSTATUS unlocked
- end
- else do
- LockedItemFlag=0
- CALL SetItem(host,1,0,LockedItemFlag,ON)
- PSTATUS locked
- end
-
- CALL AddItem(host,'Requester','REQ')
- CALL AddSubItem(host,' ReqToolsRequester','REQTOOL','R',-1)
- CALL AddSubItem(host,' Arp Requester','ARPREQ','A',-1)
-
- if RequesterItemFlag=1 then do
- CALL SetItem(host,1,1,RequesterItemFlag,ON)
- ReqFlag=1
- end
- else do
- RequesterItemFlag=0
- CALL SetItem(host,1,1,RequesterItemFlag,ON)
- ReqFlag=0
- end
-
- CALL SetAPen(host,1)
-
- /*
- Setting up our gadgets...
- */
-
- /* ------ Loader -------*/
- CALL Move(host,10,26)
- CALL Text(host,'Loader')
-
- CALL AddGadget(host,70,20,1,IMAGELOADFORMAT,'LLL||%g',150,RIDGEBORDER)
-
- /* ------ Saver -------*/
- CALL Move(host,10,42)
- CALL Text(host,'Saver')
-
- CALL AddGadget(host,70,36,2,IMAGESAVEFORMAT,'SSS||%g',150,RIDGEBORDER)
-
- /* ------ Dither -------*/
- CALL Move(host,10,58)
- CALL Text(host,'Dither 0=Off,1=Floyd..')
-
- CALL AddGadget(host,195,52,3,DITHERING,'DDD||%g',25,RIDGEBORDER)
-
- /* ------ Scale X -------*/
- CALL Move(host,10,74)
- CALL Text(host,'Absolute Scale-x')
-
- CALL AddGadget(host,170,68,4,ABSSC_X,'SSX||%g',50,RIDGEBORDER)
-
- /* ------ Scale Y -------*/
- CALL Move(host,10,90)
- CALL Text(host,'Absolute Scale-y')
-
- CALL AddGadget(host,170,84,5,ABSSC_Y,'SSY||%g',50,RIDGEBORDER)
-
- /* ------ Operator -------*/
- CALL Move(host,10,106)
- CALL Text(host,'Operator')
-
- CALL AddGadget(host,82,100,6,OPERATORNAME,'OOP||%g',118,RIDGEBORDER)
-
- /* ---- OperatorHelp ----*/
- CALL AddGadget(host,208,99,20,'?','OPHELP')
-
- /* ------ COLORS -------*/
- CALL Move(host,226,106)
- CALL Text(host,'Number of Colors')
-
- CALL AddGadget(host,360,100,7,COLORNR,'CCC||%g',40,RIDGEBORDER)
-
-
- /*
- Table to set the right Output screenresolution...
- */
-
- CALL box(host,2,1,226,17,174,77)
-
- CALL SetAPen(host,1)
- CALL Move(host,235,27)
- CALL Text(host,' Set Output Format:')
- CALL AddGadget(host,240,33,10,' Hi-Res ','RES_XH')
- CALL AddGadget(host,320,33,11,' Lo-Res ','RES_XL')
- CALL AddGadget(host,240,49,12,' Lace ','RES_YL')
- CALL AddGadget(host,320,49,13,' NoLace ','RES_YNL')
- CALL AddGadget(host,240,65,14,' HOscan ','HOVER')
- CALL AddGadget(host,320,65,15,' HSdtSz ','HSDTSZ')
- CALL AddGadget(host,240,81,16,' VOscan ','VOVER')
- CALL AddGadget(host,320,81,17,' VSdtSz ','VSDTSZ')
-
- /*
- ---------------------------------
- STATUS BOX
- ----------------------------------
- */
-
- CALL box(host,1,2,175,119,225,12) /* StatusBox */
- CALL SetAPen(host,1)
- CALL Move(host,10,128)
- CALL Text(host,'Selected Resolution:')
-
- CALL SetAPen(host,2)
- if HIRES = 0 then do
- CALL Move(host,185,128)
- CALL Text(host,'LoRes ')
- end
- else do
- CALL Move(host,185,128)
- CALL Text(host,'HiRes ')
- HIRES=1
- end
-
- if INTERLACE = 0 then do
- CALL Move(host,240,128)
- CALL Text(host,'NoLace ')
- end
- else do
- CALL Move(host,240,128)
- CALL Text(host,' Lace ')
- INTERLACE=2
- end
-
- if HOVERSCAN = 0 then do
- CALL Move(host,300,128)
- CALL Text(host,'SdtSz ')
- end
- else do
- CALL Move(host,300,128)
- CALL Text(host,'HScan ')
- HOVERSCAN=8
- end
-
- if VOVERSCAN = 0 then do
- CALL Move(host,350,128)
- CALL Text(host,'SdtSz ')
- end
- else do
- CALL Move(host,350,128)
- CALL Text(host,'VScan ')
- VOVERSCAN=16
- end
-
- /* --------------------------------- */
-
- CALL Box(host,1,2,10,ymax-23,388,1) /* Lower Line */
-
- CALL AddGadget(host,11,ymax-16,98,'START CONVERTING','OK')
- CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
- CALL AddGadget(host,(xmax/2)-10,ymax-16,97,'HELP n INFO','HELP')
-
-
- /*
- --------------------------------------------
- --- Getting our Arguments from the port ---
- --------------------------------------------
- */
-
- CALL tofront()
-
- quitflag = 0
- register = 0
- number = 0
- newnum = 1
- CALL ActivateGadget(host,1)
-
- start:
-
- do forever
- if quitflag=1 then leave
- t = waitpkt(port)
- do forever
- p = getpkt(port)
- if c2d(p) = 0 then leave
-
- arg = getarg(p,0)
- t = reply(p, 0)
-
- if arg=CLOSEWINDOW then do
- CALL CloseWindow(host)
- quitflag=1
- end
-
- if LEFT(arg,3)='LLL' THEN do
- IMAGELOADFORMAT = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,2)
- end
- if LEFT(arg,3)='SSS' THEN do
- IMAGESAVEFORMAT = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,3)
- end
- if LEFT(arg,3)='DDD' THEN do
- DITHERING = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,4)
- end
- if LEFT(arg,3)='SSX' THEN do
- ABSSC_X = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,5)
- end
- if LEFT(arg,3)='SSY' THEN do
- ABSSC_Y = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,6)
- end
- if LEFT(arg,3)='OOP' THEN do
- OPERATORNAME = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,7)
- end
- if LEFT(arg,3)='CCC' THEN COLORNR = RIGHT(arg,LENGTH(arg)-5)
-
- /*
- Returncodes for resolution settings
- when resolutionbuttons are pressed
- */
-
- if arg='RES_XH' THEN do
- HIRES=1
- CALL SetAPen(host,2)
- CALL Move(host,185,128)
- CALL Text(host,'HiRes ')
- CALL SetAPen(host,1)
- end
-
- if arg='RES_XL' THEN do
- HIRES=0
- CALL SetAPen(host,2)
- CALL Move(host,185,128)
- CALL Text(host,'LoRes ')
- CALL SetAPen(host,1)
- end
-
- if arg='RES_YL' THEN do
- INTERLACE=2
- CALL SetAPen(host,2)
- CALL Move(host,240,128)
- CALL Text(host,' Lace ')
- CALL SetAPen(host,1)
- end
-
- if arg='RES_YNL' THEN do
- INTERLACE=0
- CALL SetAPen(host,2)
- CALL Move(host,240,128)
- CALL Text(host,'NoLace ')
- CALL SetAPen(host,1)
- end
-
- if arg='HOVER' THEN do
- HOVERSCAN=8
- CALL SetAPen(host,2)
- CALL Move(host,300,128)
- CALL Text(host,'HScan ')
- CALL SetAPen(host,1)
- end
-
- if arg='HSDTSZ' THEN do
- HOVERSCAN=0
- CALL SetAPen(host,2)
- CALL Move(host,300,128)
- CALL Text(host,'SdtSz ')
- CALL SetAPen(host,1)
- end
-
- if arg='VOVER' THEN do
- VOVERSCAN=16
- CALL SetAPen(host,2)
- CALL Move(host,350,128)
- CALL Text(host,'VScan ')
- CALL SetAPen(host,1)
- end
-
- if arg='VSDTSZ' THEN do
- VOVERSCAN=0
- CALL SetAPen(host,2)
- CALL Move(host,350,128)
- CALL Text(host,'SdtSz ')
- CALL SetAPen(host,1)
- end
-
- /*
- Palette locked/unlocked status and
- ReqTools or Arp library selection
- */
-
- if arg='PLOCKED' THEN do
- CALL SetItem(host, 1, 0, 0, ON)
- CALL SetItem(host, 1, 0, 1, OFF)
- PSTATUS locked
- LockedItemFlag=0
- end
-
- if arg='PUNLOCKED' THEN do
- CALL SetItem(host, 1, 0, 0, OFF)
- CALL SetItem(host, 1, 0, 1, ON)
- PSTATUS unlocked
- LockedItemFlag=1
- end
-
- if arg='REQTOOL' THEN do
- ReqFlag=0
- CALL SetItem(host,1,1,0,ON)
- CALL SetItem(host,1,1,1,OFF)
- RequesterItemFlag=0
- end
-
- if arg='ARPREQ' THEN do
- ReqFlag=1
- CALL SetItem(host,1,1,0,OFF)
- CALL SetItem(host,1,1,1,ON)
- RequesterItemFlag=1
- end
-
- if arg='HELP' then do
- IF( ~EXISTS( "adproscripts:F0.guide")) THEN do
- ADPRO_TO_FRONT
- Okay1 "<F0.guide> not found. Please" || NL ||,
- "copy it into <adproscripts:> " || NL ||,
- "and try again "
- ADPRO_TO_BACK
- end
- IF( ~EXISTS( "sys:utilities/AmigaGuide")) THEN do
- ADPRO_TO_FRONT
- Okay1 " AmigaGuide not found. "
- ADPRO_TO_BACK
- end
- else do
- cmd = "run AmigaGuide adproscripts:F0.guide"
- ADDRESS COMMAND cmd
- end
- END
-
- if arg='OPHELP' then do
- ADPRO_TO_FRONT
- Okay1 "Special Operators" || NL ||,
- " " || NL ||,
- " +Blur " || NL ||,
- " +Ripple " || NL ||,
- " +Balance " || NL ||,
- " +Twirl " || NL ||,
- " +3DMosaik " || NL ||,
- " +HVMosaik " || NL ||,
- " +Refract " || NL ||,
- " +Emboss " || NL ||,
- " +Fresco "
- ADPRO_TO_BACK
- end
-
- if arg='SAVEPREFS' then do
- success=open(PrefsFile,'ADProScripts:F0.config','W')
- if success=0 then do
- ADPRO_TO_FRONT
- OKAY1 "Can't write Preferences!"
- ADPRO_TO_BACK
- end
- else do
- chars=writeln(PrefsFile,LockedItemFlag)
- chars=writeln(PrefsFile,RequesterItemFlag)
- chars=writeln(PrefsFile,IMAGELOADFORMAT)
- chars=writeln(PrefsFile,IMAGESAVEFORMAT)
- chars=writeln(PrefsFile,ABSSC_X)
- chars=writeln(PrefsFile,ABSSC_Y)
- chars=writeln(PrefsFile,DITHERING)
- chars=writeln(PrefsFile,HIRES)
- chars=writeln(PrefsFile,INTERLACE)
- chars=writeln(PrefsFile,HOVERSCAN)
- chars=writeln(PrefsFile,VOVERSCAN)
- chars=writeln(PrefsFile,OPERATORNAME)
- chars=writeln(PrefsFile,COLORNR)
- success=close(PrefsFile)
- end
- end
-
-
- if arg=OK then do
- CALL CloseWindow(host)
- CALL CallByReference()
- end
- end
- END
-
- EXIT
-
-
-
- /*
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- *****************************
- -----------------------------
- ---- A D P R O - P A R T ----
- -----------------------------
- *****************************
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- */
-
- CallByReference:
-
- IF OperatorName='+Ripple' | OperatorName='+RIPPLE' | OperatorName='+ripple'
- THEN CALL RippleGUI()
- IF OperatorName='+Twirl' | OperatorName='+TWIRL' | OperatorName='+twirl'
- THEN CALL TwirlGUI()
- IF OperatorName='+Emboss' | OperatorName='+EMBOSS' | OperatorName='+emboss'
- THEN CALL EmbossGUI()
- IF OperatorName='+Blur' | OperatorName='+BLUR' | OperatorName='+blur'
- THEN CALL BlurGUI()
- IF OperatorName='+Refract' | OperatorName='+REFRACT' | OperatorName='+refract'
- THEN CALL RefractGUI()
- IF OperatorName='+Balance' | OperatorName='+BALANCE' | OperatorName='+balance'
- THEN CALL BalanceGUI()
-
-
- ADPRO_TO_FRONT
-
-
- GETFILES '"Select first file to convert"'
- IF RC ~= 0 THEN DO
- CALL CloseWindow(host)
- EXIT
- END
-
- /*
- This one is for the fist file entry.
- */
-
- TheFiles = ADPRO_RESULT
- NumberOfFiles = WORDS(TheFiles)
-
-
- if reqflag=1 then do /* That means Arp-library active! */
- string = word(TheFiles,1)
- laenge = length(string)
- pointpos = lastpos(".",string)
- indexdigits = laenge - pointpos
- number = right(string,indexdigits)
- end
- else do /* ReqTools-library active! */
- string = word(TheFiles,1)
- laenge = length(string)
- realstring = left(string,laenge-1)
- reallength = length(realstring)
- pointpos = lastpos(".",realstring)
- indexdigits = reallength - pointpos
- number = right(realstring,indexdigits)
- end
-
- if indexdigits ~= "3" then do
- OKAY1 ,
- " The Fileindex must have three " || NL ||,
- " digits as suffix! " || NL ||,
- " Example: Picname.000 " || NL ||,
- " or Picname.269 " || NL ||,
- " " || NL ||,
- " Possible Errors: " || NL ||,
- " - Wrong library (If you use " || NL ||,
- " RTPatch you must choose the " || NL ||,
- " ReqToolsLibrary from the menu) " || NL ||,
- " - Wrong Fileindex (see above!) " || NL ||,
- " "
- EXIT
- end
-
- /*
- This one is for the last file entry.
- */
-
- GETFILES '"Select last file to convert"'
- IF RC ~= 0 THEN DO
- CALL CloseWindow(host)
- EXIT
- END
-
- TheFiles2 = ADPRO_RESULT
- NumberOfFiles2 = WORDS(TheFiles2)
-
-
- if reqflag=1 then do /* That means Arp-library active! */
- string2 = word(TheFiles2,1)
- laenge2 = length(string2)
- pointpos2 = lastpos(".",string2)
- indexdigits2 = laenge2 - pointpos2
- number2 = right(string2,indexdigits2)
- end
- else do /* ReqTools-library active! */
- string2 = word(TheFiles2,1)
- laenge2 = length(string2)
- realstring2 = left(string2,laenge2-1)
- reallength2 = length(realstring2)
- pointpos2 = lastpos(".",realstring2)
- indexdigits2 = reallength2 - pointpos2
- number2 = right(realstring2,indexdigits2)
- end
-
- if indexdigits2 ~= "3" then do
- OKAY1 ,
- " The Fileindex must have three " || NL ||,
- " digits as suffix! " || NL ||,
- " Example: Picname.000 " || NL ||,
- " or Picname.269 " || NL ||,
- " " || NL ||,
- " Possible Errors: " || NL ||,
- " - Wrong library (If you use " || NL ||,
- " RTPatch you must choose the " || NL ||,
- " ReqToolsLibrary from the menu) " || NL ||,
- " - Wrong Fileindex (see above!) " || NL ||,
- " "
- EXIT
- end
-
- body = left(string,pointpos)
- diff = number2 - number
-
- /* -------------------------------------*/
- GETFILES '"Select Output Path"'
- IF RC ~= 0 THEN DO
- CALL CloseWindow(host)
- EXIT
- END
-
- TheSaveFiles = ADPRO_RESULT
- OUT_FILE = TheSaveFiles
-
- /*
- If Reqtools.library is active
- */
-
- if reqflag=0 then do
- OUT_FILE = right(OUT_FILE,length(OUT_FILE)-1)
- OUT_FILE = left(OUT_FILE,length(OUT_FILE)-2)
- end
-
- PicSaveCounter = 1
- NewFileCounter=0
-
-
- /*
- If "RAW" is selected in the ColorNR gadget, the conversation
- must be done in 24-bit mode
- */
- if COLORNR = 'RAW' | COLORNR = 'raw' | COLORNR = 'Raw' then
- CALL 24bit_conv()
-
-
- do while NewFileCounter <= diff
-
- in_file = body || right(Number+NewFilecounter,3,'0')
-
- /*
- ^ automatic adding of 000's in only one line!!!
- */
-
- /* -------------------------------------*/
- lformat ImageLoadFormat
- load in_file
-
- if RC ~= 0 then do
- okay1 "Error loading" || NL ||,
- in_file
- EXIT
- END
-
- /* -------------------Screenparameter---*/
- PTOTAL ColorNr
- DITHER Dithering
- If left(OperatorName,1) ~= '+' & Operatorname ~= 'NONE' then OPERATOR OperatorName
- CALL OperatorCalls()
- if AbsSc_x ~= "-1" | AbsSc_y ~= "-1" then
- ABS_SCALE AbsSc_x AbsSc_y
- RENDER_TYPE ColorNr /* Number of colors */
- SCREEN_TYPE HIRES + INTERLACE + HOVERSCAN + VOVERSCAN + 4
- /* -------------------------------------*/
- Execute
- /* -------------------------------------*/
- PSTATUS locked
- Display = 1
- If Display = 1 then ADPRO_DISPLAY
- SFORMAT ImageSaveFormat
-
- SaveName = OUT_FILE || . || right(PicSaveCounter,3,'0')
- save SaveName "IMAGE"
-
- PicSaveCounter = PicSaveCounter + 1
- NewFileCounter = NewFileCounter + 1
- end
-
- EXIT
- RETURN
-
- /*
- -----------------------
- ---- Procedures -------
- -----------------------
- */
-
- /*
- Procedure if the RAW ColorNR Gadget is activated.
- */
-
- 24bit_conv:
- do while NewFileCounter <= diff
-
- in_file=body || right(number+NewFileCounter,3,'0')
-
-
- /* -------------------------------------*/
- lformat ImageLoadFormat
- load in_file
-
- if RC ~= 0 then do
- okay1 "Could not Load" in_file
- CALL CloseWindow(host)
- EXIT
- END
-
- /* -------------------Screenparameter---*/
- DITHER Dithering
- If left(OperatorName,1) ~= '+' & OperatorName ~= 'NONE' then OPERATOR OperatorName
- CALL OperatorCalls()
- if AbsSc_x ~= "-1" | AbsSc_y ~= "-1" then
- ABS_SCALE AbsSc_x AbsSc_y
- SCREEN_TYPE HIRES + INTERLACE + HOVERSCAN + VOVERSCAN + 4
- SFORMAT ImageSaveFormat
-
- SaveName = OUT_FILE || . || right(PicSaveCounter,3,'0')
- save SaveName "RAW"
-
- PicSaveCounter = PicSaveCounter + 1
- NewFileCounter=NewFileCounter+1
- end
- EXIT
- RETURN
-
-
- /* -------------------------
- -- Operator Procedures --
- -------------------------
- */
-
- OperatorCalls:
- If OperatorName = '+Twirl' | OperatorName='+TWIRL' | OperatorName='+twirl' then
- CALL TwirlOperator()
- If OperatorName = '+Ripple' | OperatorName='+ripple' | OperatorName='+RIPPLE' then
- CALL RippleOperator()
- If OperatorName = '+Blur' | OperatorName='+blur' | OperatorName='+BLUR' then
- CALL BlurOperator()
- If OperatorName = '+3DMosaik' | OperatorName='+3dmosaik' | OperatorName='+3DMOSAIK' then
- CALL 3DMosaikOperator()
- If OperatorName = '+HVMosaik' | OperatorName='+hvmosaik' | OperatorName='+HVMOSAIK' then
- CALL HVMosaikOperator()
- If OperatorName = '+Emboss' | OperatorName='+emboss' | OperatorName='+EMBOSS' then
- CALL EmbossOperator()
- If OperatorName = '+Fresco' | OperatorName='+fresco' | OperatorName='+FRESCO' then
- CALL FrescoOperator()
- If OperatorName = '+Refract' | OperatorName='+refract' | OperatorName='+REFRACT' then
- CALL RefractOperator()
- IF OperatorName = '+Balance' | OperatorName='+BALANCE' | OperatorName='+balance' then
- CALL BalanceControl()
- RETURN
-
- /*
- ******************************************
- ********* SPECIAL OPERATORS *********
- ******************************************
- */
-
- TwirlOperator:
- if EWidth='CenterX' then do /* ENTRY */
- XSIZE
- EWidth=ADPRO_RESULT % 2
- end
- if EHight='CenterY' then do
- YSIZE
- EHight=ADPRO_RESULT % 2
- end
- if ERadius='Image' then do
- XSIZE
- ERadius=ADPRO_RESULT % 2
- end
-
- if XWidth='CenterX' then do /* EXIT */
- XSIZE
- XWidth=ADPRO_RESULT % 2
- end
- if XHight='CenterY' then do
- YSIZE
- XHight=ADPRO_RESULT % 2
- end
- if XRadius='Image' then do
- XSIZE
- XRadius=ADPRO_RESULT % 2
- end
-
- /*
- Algorythm to interpolate Entry and Exit values.
- */
-
- if TwirlFlag ~= 999 then do
- _Width = (XWidth - EWidth) % diff
- if _Width < 0 then Width = EWidth
- else
- Width = EWidth
- _Hight = (XHight - EHight) % diff
- if _Hight < 0 then Hight = EHight
- else
- Hight = EHight
- _Radius = (XRadius - ERadius) % diff
- if _Radius < 0 then Radius = ERadius
- else
- Radius = ERadius
- _Amount = (XAmount - EAmount) % diff
- if _Amount < 0 then Amount = -EAmount
- else
- Amount = EAmount
- _BlurRadius = (XBlurRadius - EBlurRadius) % diff
- if _BlurRadius < 0 then BlurRadius = EBlurRadius
- else
- BlurRadius = EBlurRadius
- TwirlFlag = 999
- end
-
- else do
- if _Width < 0 then Width = Width + _Width
- else
- Width = Width + _Width
-
- if _Hight < 0 then Hight = Hight + _Hight
- else
- Hight = Hight + _Hight
-
- if _Radius < 0 then Radius = Radius + _Radius
- else
- Radius = Radius + _Radius
-
- if _Amount < 0 then Amount = Amount - _Amount /* ( - and - is + !!!) */
- else
- Amount = Amount + _Amount
-
- if _BlurRadius < 0 then BlurRadius = BlurRadius + _Radius
- else
- BlurRadius = BlurRadius + _BlurRadius
- end
-
- Operator "TWIRL",
- "CENTER" Width Hight "RADIUS" Width "AMOUNT" Amount,
- "BLUR_RADIUS" BlurRadius "QUALITY_HIGH"
- RETURN
-
- /*-----------------------------------------------------------*/
-
- RippleOperator:
- If XPos='CenterX' then do
- XSIZE
- XPos=ADPRO_RESULT % 2
- end
- If YPos='CenterY' then do
- YSIZE
- YPos=ADPRO_RESULT % 2
- end
-
- if RippleFlag ~= 999 then do
- Phase = 0
- RippleFlag = 999
- end
-
- phase=phase + (360 % diff)
-
- Operator "RIPPLE",
- "CENTER" XPos YPos "PROPSPEED" Speed "PERIOD" Period "AMPLITUDE" Amplitude,
- "PHASE" Phase "RAMP" Ramp "LEVELOFF" Leveloff "WAVETYPE" Wavetype "FRAME" Frame "NEWWAVE"
- RETURN
- /*-----------------------------------------------------------*/
-
- BlurOperator:
- Operator "BLUR" CW TH
- RETURN
- /*-----------------------------------------------------------*/
-
- 3DMosaikOperator:
-
- IF( ~EXISTS( "adpro:convolutions/DeepPress" )) THEN DO
- ADPRO_TO_FRONT
- OKAY1 "The convolution DeepPress," || NL ||,
- "cannot be found."
- EXIT
- END
-
- XSIZE
- XCoord = ADPRO_RESULT
- YSIZE
- YCoord = ADPRO_RESULT
-
- do loop = 1 TO 3
- OPERATOR "HALVE"
- END
-
- ABS_SCALE XCoord YCoord
-
- OPERATOR "CONVOLVE" "adpro:convolutions/DeepPress" 100 0
- RETURN
- /*-----------------------------------------------------------*/
-
- HVMosaikOperator:
- IF( ~EXISTS( "adpro:convolutions/Vertical" )) THEN DO
- OKAY1 "The convolution Vertical," || NL ||,
- "cannot be found."
- EXIT
- END
- IF( ~EXISTS( "adpro:convolutions/Horizontal" )) THEN DO
- OKAY1 "The convolution Horizontal," || NL ||,
- "cannot be found."
- EXIT
- END
-
- XSIZE
- XCoord = ADPRO_RESULT
- YSIZE
- YCoord = ADPRO_RESULT
-
- DO loop = 1 TO 2
- OPERATOR "HALVE"
- END
-
- OPERATOR "BLUR" 0 0
- ABS_SCALE XCoord YCoord
-
- OPERATOR "CONVOLVE" "adpro:convolutions/Vertical" 100 0
-
- OPERATOR "CONVOLVE" "adpro:convolutions/Horizontal" 100 0
-
- RETURN
- /*-----------------------------------------------------------*/
-
- EmbossOperator:
- TempImage = "T:TempImage"
-
- SAVE TempImage "RAW"
- IF( RC ~= 0 ) THEN DO
- ADPRO_TO_FRONT
- OKAY1 "Saving copy of image failed." || NL ||,
- "Argument Information:" || NL ||,
- "Filename = " || TempImage || NL ||,
- "Type = " || "RAW"
- EXIT 10
- END
-
- OPERATOR "NEGATIVE"
-
- IF EmbossFlag=1 then do /* ---- Emboss out -----*/
- LOAD TempImage (-1) (-1) 50
- IF( RC ~= 0 ) THEN DO
- OKAY1 "Error loading temp image."
- EXIT
- END
- end
-
- ELSE DO /* ---- Emboss in -----*/
- LOAD TempImage 1 1 50
- IF( RC ~= 0 ) THEN DO
- OKAY1 "Error loading temp image."
- EXIT
- END
- end
-
- IF( RC ~= 0 ) THEN DO
- ADPRO_TO_FRONT
- OKAY1 "Reloading image failed." || NL ||,
- "Argument Information:" || NL ||,
- "X = " || 1 || NL ||,
- "Y = " || 1 || NL ||,
- "Mix = " || 50
- EXIT
- END
-
- IF( WORD( ImageType, 1 ) ~= "GRAY" ) THEN DO
- OPERATOR "COLOR_TO_GRAY"
- IF( RC ~= 0 ) THEN DO
- OKAY1 "The operator COLOR_TO_GRAY," || NL ||,
- "failed to execute."
- EXIT
- END
- END
-
- CONTRAST 50
- OPERATOR "APPLY_MAP"
- ADDRESS COMMAND "delete" TempImage
- RETURN
- /*-----------------------------------------------------------*/
-
- FrescoOperator:
- IF( ~EXISTS( "adpro:convolutions/WoodCut" )) THEN DO
- OKAY1 "The convolution WoodCut," || NL ||,
- "cannot be found."
- EXIT
- END
-
- DO loop = 1 TO 3
- IF( loop < 3 ) THEN
- OPERATOR "DISPLACE_PIXEL" 1 100 0
- ELSE
- OPERATOR "DISPLACE_PIXEL" 2 100 0
-
- OPERATOR "MEDIAN_FILTER" 0
- END
-
- OPERATOR "CONVOLVE" "adpro:convolutions/WoodCut" 100 0
- RETURN
- /*-----------------------------------------------------------*/
-
- RefractOperator:
- OPERATOR "REFRACT" "Pooldepth" Pooldepth "Refractindex" Refractindex "Filename" FileName
- RETURN
- /*-----------------------------------------------------------*/
-
- BalanceControl:
-
- /*
- Algorythm to interpolate Entry and Exit values.
- */
-
- if BalanceFlag ~= 999 then do
- _Red = (ABS(XRed) + ABS(ERed)) / diff
- _Green = (ABS(XGreen) + ABS(EGreen)) / diff
- _Blue = (ABS(XBlue) + ABS(EBlue)) / diff
- _Bright = (ABS(XBright) + ABS(EBright)) / diff
- _Contrast = (ABS(XContrast) + ABS(EContrast)) / diff
- _Gamma = (ABS(XGamma) + ABS(EGamma)) / diff
- BalanceFlag = 999
- end
-
- else do
- ERed = TRUNC(ERed + _Red)
- EGreen = TRUNC(EGreen + _Green)
- EBlue = TRUNC(EBlue + _Blue)
- EBright = TRUNC(EBright + _Bright)
- EContrast = TRUNC(EContrast + _Contrast)
- EGamma = TRUNC(EGamma + _Gamma)
- end
-
-
- Red ERed
- Green EGreen
- Blue EBlue
- Brightness EBright
- Contrast EContrast
- Gamma EGamma
-
- OPERATOR "APPLY_MAP"
- RETURN
- /*-----------------------------------------------------------*/
-
- /*
- Operator GUIs...
- */
-
- /* -------------------------------- */
- RippleGUI:
-
- host='RIPPLEHOST'
- port='RIPPLEPORT'
- IF replyport='' THEN DO
- DO i=1 WHILE SHOW('P',host||i)
- END
- host=host||i
- port=port||i
- END
- ELSE DO
- host=host'.'replyport
- port=port'.'replyport
- IF SHOW('P',port) THEN DO
- INTERPRET ADDRESS port FRONT
- EXIT(0)
- END
- END
-
- CALL setup_host()
-
- w.=''
- w.idcmp='CLOSEWINDOW+MENUPICK+GADGETUP+MOUSEBUTTONS'
- w.flags='WINDOWCLOSE+WINDOWDRAG'
-
- w.title='Ripple Operator Interface V1.0'
- IF replyport~='' THEN w.title='Ripple Operator Interface V1.0'
-
- pscreen='Workbench'
- xmax=240
- ymax=200
- CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
- (ScreenRows(pscreen)-ymax)%2, ,
- xmax,ymax,w.idcmp,w.flags,w.title)
-
- /* -------- MENUES --------- */
-
- CALL AddMenu(host,'Project')
- CALL AddItem(host,'Start ','OK','S')
- CALL AddItem(host,'Quit ','CLOSEWINDOW','Q')
-
- CALL SetAPen(host,1)
-
- /* ------ CenterX -------*/
- CALL Move(host,10,36)
- CALL Text(host,'Centerposition X')
-
- CALL AddGadget(host,160,30,1,'CenterX','XXX||%g',70,RIDGEBORDER)
-
- /* ------ CenterY -------*/
- CALL Move(host,10,52)
- CALL Text(host,'Centerposition Y')
-
- CALL AddGadget(host,160,46,2,'CenterY','YYY||%g',70,RIDGEBORDER)
-
- /* ------ Propspeed -------*/
- CALL Move(host,10,68)
- CALL Text(host,'Propspeed (1..5000)')
-
- CALL AddGadget(host,180,62,3,'20','PRO||%g',50,RIDGEBORDER)
-
- /* ------ Period -------*/
- CALL Move(host,10,84)
- CALL Text(host,'Period (3..5000)')
-
- CALL AddGadget(host,180,78,4,'10','PER||%g',50,RIDGEBORDER)
-
- /* ------ Amplitude -------*/
- CALL Move(host,10,100)
- CALL Text(host,'Amplitude (1.0..500)')
-
- CALL AddGadget(host,180,94,5,'15','AMP||%g',50,RIDGEBORDER)
-
- /* ------ Ramp -------*/
- CALL Move(host,10,116)
- CALL Text(host,'Ramp (0.0..1000.0)')
-
- CALL AddGadget(host,180,110,6,'0','RMP||%g',50,RIDGEBORDER)
-
- /* ------ Leveloff -------*/
- CALL Move(host,10,132)
- CALL Text(host,'Leveloff (0..1000)')
-
- CALL AddGadget(host,180,126,7,'0','LEV||%g',50,RIDGEBORDER)
-
- /* ------ Wavetype -------*/
- CALL Move(host,10,148)
- CALL Text(host,'Wavetype (-1,0,1)')
-
- CALL AddGadget(host,180,142,8,'0','WAV||%g',50,RIDGEBORDER)
-
- /* ------ Frame -------*/
- CALL Move(host,10,164)
- CALL Text(host,'Frame (-10000..10000)')
-
- CALL AddGadget(host,180,158,9,'20','FRM||%g',50,RIDGEBORDER)
-
-
- CALL AddGadget(host,11,ymax-16,98,'START CONVERTING','OK')
- CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
- CALL AddGadget(host,153,ymax-16,100,'!','ALERT')
-
- CALL tofront()
-
- Defaults:
- XPos = 'CenterX'
- YPos = 'CenterY'
- Speed = 20
- Period = 10
- Amplitude = 15
- Ramp = 0
- Leveloff = 0
- Wavetype = 0
- Frame = 20
-
-
- quitflag = 0
- CALL ActivateGadget(host,1)
-
- startripple:
- do forever
- if quitflag=1 then leave
- t = waitpkt(port)
- do forever
- p = getpkt(port)
- if c2d(p) = 0 then leave
-
- arg = getarg(p,0)
- t = reply(p, 0)
-
- if arg=CLOSEWINDOW then do
- CALL CloseWindow(host)
- EXIT
- end
-
- if LEFT(arg,3)='XXX' THEN do
- XPos = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,2)
- end
- if LEFT(arg,3)='YYY' THEN do
- YPos = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,3)
- end
- if LEFT(arg,3)='PRO' THEN do
- Speed = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,4)
- end
- if LEFT(arg,3)='PER' THEN do
- Period = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,5)
- end
- if LEFT(arg,3)='AMP' THEN do
- Amplitude = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,6)
- end
- if LEFT(arg,3)='RMP' THEN do
- Ramp = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,7)
- end
- if LEFT(arg,3)='LEV' THEN do
- Leveloff = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,8)
- end
- if LEFT(arg,3)='WAV' THEN do
- Wavetype = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,9)
- end
- if LEFT(arg,3)='FRM' THEN Frame = RIGHT(arg,LENGTH(arg)-5)
-
- if arg='ALERT' then do
- ADPRO_TO_FRONT
- okay1 "If Wavetype -1 (decrease) or" || NL ||,
- "1 (increase) is selected, RAMP" || NL ||,
- "and LEVELOFF must be set" || NL ||,
- "higher than 0 otherwhise it" || NL ||,
- "will not work."
- ADPRO_TO_BACK
- end
-
- if arg=OK THEN DO
- CALL CloseWindow(host)
- RETURN
- end
- end
- END
- RETURN
-
- /* -------------------------------- */
-
- TwirlGUI:
-
- host='TWIRLHOST'
- port='TWIRLEPORT'
- IF replyport='' THEN DO
- DO i=1 WHILE SHOW('P',host||i)
- END
- host=host||i
- port=port||i
- END
- ELSE DO
- host=host'.'replyport
- port=port'.'replyport
- IF SHOW('P',port) THEN DO
- INTERPRET ADDRESS port FRONT
- EXIT(0)
- END
- END
-
- CALL setup_host()
-
- w.=''
- w.idcmp='CLOSEWINDOW+MENUPICK+GADGETUP+MOUSEBUTTONS'
- w.flags='WINDOWCLOSE+WINDOWDRAG'
-
- w.title='Twirl Operator Interface V1.0'
- IF replyport~='' THEN w.title='Twirl Operator Interface V1.0'
-
- pscreen='Workbench'
- xmax=492
- ymax=150
- CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
- (ScreenRows(pscreen)-ymax)%2, ,
- xmax,ymax,w.idcmp,w.flags,w.title)
-
-
- /* -------- MENUES --------- */
-
- CALL AddMenu(host,'Project')
- CALL AddItem(host,'Start ','OK','S')
- CALL AddItem(host,'Quit ','CLOSEWINDOW','Q')
-
- CALL box(host,2,1,6,17,230,110)
- CALL box(host,1,1,10,21,223,13)
-
- CALL box(host,2,1,255,17,230,110)
- CALL box(host,1,1,259,21,223,13)
-
- CALL SetAPen(host,2)
- CALL Move(host,100,30)
- CALL Text(host,'Entry')
-
- CALL Move(host,350,30)
- CALL Text(host,'Exit')
-
- CALL SetAPen(host,1)
-
- /* ------- ENTRY --------*/
-
- /* ------ CenterX -------*/
- CALL Move(host,10,56)
- CALL Text(host,'Centerposition X')
-
- CALL AddGadget(host,160,50,1,'CenterX','EXX||%g',70,RIDGEBORDER)
-
- /* ------ Center Y -------*/
- CALL Move(host,10,72)
- CALL Text(host,'Centerposition Y')
-
- CALL AddGadget(host,160,66,2,'CenterY','EYY||%g',70,RIDGEBORDER)
-
- /* ------ Radius -------*/
- CALL Move(host,10,88)
- CALL Text(host,'Radius (5..15000)')
-
- CALL AddGadget(host,180,82,3,'Image','ERR||%g',50,RIDGEBORDER)
-
- /* ------ Amount -------*/
- CALL Move(host,10,104)
- CALL Text(host,'Amount (-360..360°)')
-
- CALL AddGadget(host,180,98,4,'360','EAA||%g',50,RIDGEBORDER)
-
- /* ------ BlurRadius -------*/
- CALL Move(host,10,120)
- CALL Text(host,'Blur Radius (0..99%)')
-
- CALL AddGadget(host,180,114,5,'30','EBB||%g',50,RIDGEBORDER)
-
-
- /* -------- EXIT --------*/
-
- /* ------ CenterX -------*/
- CALL Move(host,260,56)
- CALL Text(host,'Centerposition X')
-
- CALL AddGadget(host,410,50,6,'CenterX','XXX||%g',70,RIDGEBORDER)
-
- /* ------ Center Y -------*/
- CALL Move(host,260,72)
- CALL Text(host,'Centerposition Y')
-
- CALL AddGadget(host,410,66,7,'CenterY','XYY||%g',70,RIDGEBORDER)
-
- /* ------ Radius -------*/
- CALL Move(host,260,88)
- CALL Text(host,'Radius (5..15000)')
-
- CALL AddGadget(host,430,82,8,'Image','XRR||%g',50,RIDGEBORDER)
-
- /* ------ Amount -------*/
- CALL Move(host,260,104)
- CALL Text(host,'Amount (-360..360°)')
-
- CALL AddGadget(host,430,98,9,'360','XAA||%g',50,RIDGEBORDER)
-
- /* ------ BlurRadius -------*/
- CALL Move(host,260,120)
- CALL Text(host,'Blur Radius (0..99%)')
-
- CALL AddGadget(host,430,114,10,'30','XBB||%g',50,RIDGEBORDER)
-
- /* -------------------------*/
-
- CALL AddGadget(host,11,ymax-16,98,'START CONVERTING','OK')
- CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
-
- CALL tofront()
-
- Defaults:
- EWidth = 'CenterX'
- EHight = 'CenterY'
- ERadius = 'Image'
- EAmount = 360
- EBlurRadius = 30
-
- XWidth = 'CenterX'
- XHight = 'CenterY'
- XRadius = 'Image'
- XAmount = 360
- XBlurRadius = 30
-
-
- quitflag = 0
- CALL ActivateGadget(host,1)
-
- starttwirl:
- do forever
- if quitflag=1 then leave
- t = waitpkt(port)
- do forever
- p = getpkt(port)
- if c2d(p) = 0 then leave
-
- arg = getarg(p,0)
- t = reply(p, 0)
-
- /* ENTRY */
- if LEFT(arg,3)='EXX' THEN do
- EWidth = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,2)
- end
- if LEFT(arg,3)='EYY' THEN do
- EHight = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,3)
- end
- if LEFT(arg,3)='ERR' THEN do
- ERadius = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,4)
- end
- if LEFT(arg,3)='EAA' THEN do
- EAmount = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,5)
- end
- if LEFT(arg,3)='EBB' THEN do
- EBlurRadius = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,6)
- end
-
- /* EXIT */
- if LEFT(arg,3)='XXX' THEN do
- XWidth = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,7)
- end
- if LEFT(arg,3)='XYY' THEN do
- XHight = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,8)
- end
- if LEFT(arg,3)='XRR' THEN do
- XRadius = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,9)
- end
- if LEFT(arg,3)='XAA' THEN do
- XAmount = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,10)
- end
- if LEFT(arg,3)='XBB' THEN XBlurRadius = RIGHT(arg,LENGTH(arg)-5)
-
- if arg=CLOSEWINDOW then do
- CALL CloseWindow(host)
- EXIT
- end
-
- if arg=OK THEN DO
- CALL CloseWindow(host)
- RETURN
- end
- end
- END
- RETURN
-
- /* -------------------------------- */
-
- EmbossGUI:
- ADPRO_TO_FRONT
-
- Okay2 "Select direction to emboss:" || NL ||,
- "OK=Emboss in Cancel=Emboss out"
- if RC=0 then EmbossFlag=1
- else EmbossFlag=0
-
- RETURN
-
- /* -------------------------------- */
-
- BlurGUI:
-
- ADPRO_TO_FRONT
-
- GETNUMBER '"Enter Center Weight:"' 1 0 16
- CW = ADPRO_RESULT
-
- GETNUMBER '"Enter Threshold:"' 0 0 255
- TH = ADPRO_RESULT
-
- RETURN
-
- /* -------------------------------- */
-
- RefractGUI:
-
- host='REFRACTHOST'
- port='REFRACTPORT'
- IF replyport='' THEN DO
- DO i=1 WHILE SHOW('P',host||i)
- END
- host=host||i
- port=port||i
- END
- ELSE DO
- host=host'.'replyport
- port=port'.'replyport
- IF SHOW('P',port) THEN DO
- INTERPRET ADDRESS port FRONT
- EXIT(0)
- END
- END
-
- CALL setup_host()
-
- w.=''
- w.idcmp='CLOSEWINDOW+MENUPICK+GADGETUP+MOUSEBUTTONS'
- w.flags='WINDOWCLOSE+WINDOWDRAG'
-
- w.title='Refract Operator Interface V1.0'
- IF replyport~='' THEN w.title='Refract Operator Interface V1.0'
-
- pscreen='Workbench'
- xmax=300
- ymax=80
- CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
- (ScreenRows(pscreen)-ymax)%2, ,
- xmax,ymax,w.idcmp,w.flags,w.title)
-
-
- /* -------- MENUES --------- */
-
- CALL AddMenu(host,'Project')
- CALL AddItem(host,'Start ','OK','S')
- CALL AddItem(host,'Quit ','CLOSEWINDOW','Q')
-
- CALL SetAPen(host,1)
-
- /* ------ PoolDepth -------*/
- CALL Move(host,10,30)
- CALL Text(host,'Pool Depth (1.0..500.0)')
-
- CALL AddGadget(host,238,23,1,'50','PDH||%g',50,RIDGEBORDER)
-
- /* ------ Refraction Index -------*/
- CALL Move(host,10,50)
- CALL Text(host,'Refraction Index (1.0..10.0)')
-
- CALL AddGadget(host,248,43,2,'1.3','RCT||%g',40,RIDGEBORDER)
-
- /* -------------------------*/
-
- CALL AddGadget(host,11,ymax-16,98,'START CONVERTING','OK')
- CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
- CALL AddGadget(host,180,ymax-16,100,'!','ALERT')
-
- CALL tofront()
-
- POOLDEPTH = 50
- REFRACTINDEX = 1.3
-
-
-
- quitflag = 0
- CALL ActivateGadget(host,1)
-
- startrefract:
- do forever
- if quitflag=1 then leave
- t = waitpkt(port)
- do forever
- p = getpkt(port)
- if c2d(p) = 0 then leave
-
- arg = getarg(p,0)
- t = reply(p, 0)
-
-
- if LEFT(arg,3)='PDH' THEN do
- POOLDEPTH = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,2)
- end
- if LEFT(arg,3)='RCT' THEN REFRACTINDEX = RIGHT(arg,LENGTH(arg)-5)
-
- if arg=CLOSEWINDOW then do
- CALL CloseWindow(host)
- EXIT
- end
-
- if arg='ALERT' then do
- ADPRO_TO_FRONT
- okay1 "Refraction picture must have" || NL ||,
- "same size as source pic(s)!"
- ADPRO_TO_BACK
- end
-
- if arg=OK THEN DO
- CALL CloseWindow(host)
- ADPRO_TO_FRONT
- GETFILE '"Select a file to refract"'
- filename=ADPRO_RESULT
- if RC ~= 0 then do
- Okay1 "There is no picture" || NL ||,
- "to refract!"
- exit
- end
- RETURN
- end
- end
- END
- RETURN
-
- /* -------------------------------- */
-
- BalanceGUI:
-
- host='BALANCEHOST'
- port='BALANCEPORT'
- IF replyport='' THEN DO
- DO i=1 WHILE SHOW('P',host||i)
- END
- host=host||i
- port=port||i
- END
- ELSE DO
- host=host'.'replyport
- port=port'.'replyport
- IF SHOW('P',port) THEN DO
- INTERPRET ADDRESS port FRONT
- EXIT(0)
- END
- END
-
- CALL setup_host()
-
- w.=''
- w.idcmp='CLOSEWINDOW+MENUPICK+GADGETUP+MOUSEBUTTONS'
- w.flags='WINDOWCLOSE+WINDOWDRAG'
-
- w.title='Balancing Control'
- IF replyport~='' THEN w.title='Balancing Control'
-
- pscreen='Workbench'
- xmax=492
- ymax=170
- CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
- (ScreenRows(pscreen)-ymax)%2, ,
- xmax,ymax,w.idcmp,w.flags,w.title)
-
-
- /* -------- MENUES --------- */
-
- CALL AddMenu(host,'Project')
- CALL AddItem(host,'Start ','OK','S')
- CALL AddItem(host,'Quit ','CLOSEWINDOW','Q')
-
- CALL SetAPen(host,1)
-
- CALL box(host,2,1,6,17,230,130)
- CALL box(host,1,1,10,21,223,13)
-
- CALL box(host,2,1,255,17,230,130)
- CALL box(host,1,1,259,21,223,13)
-
- CALL SetAPen(host,2)
- CALL Move(host,100,30)
- CALL Text(host,'Entry')
-
- CALL Move(host,350,30)
- CALL Text(host,'Exit')
-
- CALL SetAPen(host,1)
-
- /* ------- ENTRY --------*/
-
- /* ------ Red -------*/
- CALL Move(host,10,56)
- CALL Text(host,'Red Adjust (-50..50)')
-
- CALL AddGadget(host,200,50,1,'0','ERR||%g',30,RIDGEBORDER)
-
- /* ------ Green -------*/
- CALL Move(host,10,72)
- CALL Text(host,'Green Adjust (-50..50)')
-
- CALL AddGadget(host,200,66,2,'0','EGG||%g',30,RIDGEBORDER)
-
- /* ------ Blue -------*/
- CALL Move(host,10,88)
- CALL Text(host,'Blue Adjust (-50..50)')
-
- CALL AddGadget(host,200,82,3,'0','EBB||%g',30,RIDGEBORDER)
-
- /* ------ Brightness -------*/
- CALL Move(host,10,104)
- CALL Text(host,'Brightness (-50..50)')
-
- CALL AddGadget(host,200,98,4,'0','EBR||%g',30,RIDGEBORDER)
-
- /* ------ Contrast -------*/
- CALL Move(host,10,120)
- CALL Text(host,'Contrast (-50..50)')
-
- CALL AddGadget(host,200,114,5,'0','ECC||%g',30,RIDGEBORDER)
-
- /* ------ Gamma -------*/
- CALL Move(host,10,136)
- CALL Text(host,'Gamma (-50..50)')
-
- CALL AddGadget(host,200,130,6,'0','EGM||%g',30,RIDGEBORDER)
-
-
- /* -------- EXIT --------*/
-
- /* ------ Red -------*/
- CALL Move(host,260,56)
- CALL Text(host,'Red Adjust (-50..50)')
-
- CALL AddGadget(host,450,50,7,'0','XRR||%g',30,RIDGEBORDER)
-
- /* ------ Green -------*/
- CALL Move(host,260,72)
- CALL Text(host,'Green Adjust (-50..50)')
-
- CALL AddGadget(host,450,66,8,'0','XGG||%g',30,RIDGEBORDER)
-
- /* ------ Blue -------*/
- CALL Move(host,260,88)
- CALL Text(host,'Blue Adjust (-50..50)')
-
- CALL AddGadget(host,450,82,9,'0','XBB||%g',30,RIDGEBORDER)
-
- /* ------ Brightness -------*/
- CALL Move(host,260,104)
- CALL Text(host,'Brightness (-50..50)')
-
- CALL AddGadget(host,450,98,10,'0','XBR||%g',30,RIDGEBORDER)
-
- /* ------ Contrast -------*/
- CALL Move(host,260,120)
- CALL Text(host,'Contrast (-50..50)')
-
- CALL AddGadget(host,450,114,11,'0','XCC||%g',30,RIDGEBORDER)
-
- /* ------ Gamma -------*/
- CALL Move(host,260,136)
- CALL Text(host,'Gamma (-50..50)')
-
- CALL AddGadget(host,450,130,12,'0','XGM||%g',30,RIDGEBORDER)
-
- /* -------------------------*/
-
- CALL AddGadget(host,11,ymax-16,98,'START CONVERTING','OK')
- CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
-
- CALL tofront()
-
- Defaults:
- ERed = 0
- EGreen = 0
- EBlue = 0
- EBright = 0
- EContrast = 0
- EGamma = 0
-
- XRed = 0
- XGreen = 0
- XBlue = 0
- XBright = 0
- XContrast = 0
- XGamma = 0
-
- /* -------------------------*/
-
- quitflag = 0
- CALL ActivateGadget(host,1)
-
- do forever
- if quitflag=1 then leave
- t = waitpkt(port)
- do forever
- p = getpkt(port)
- if c2d(p) = 0 then leave
-
- arg = getarg(p,0)
- t = reply(p, 0)
-
- /* ENTRY */
- if LEFT(arg,3)='ERR' THEN do
- ERed = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,2)
- end
- if LEFT(arg,3)='EGG' THEN do
- EGreen = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,3)
- end
- if LEFT(arg,3)='EBB' THEN do
- EBlue = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,4)
- end
- if LEFT(arg,3)='EBR' THEN do
- EBright = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,5)
- end
- if LEFT(arg,3)='ECC' THEN do
- EContrast = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,6)
- end
- if LEFT(arg,3)='EGM' THEN do
- EGamma = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,7)
- end
-
- /* EXIT */
- if LEFT(arg,3)='XRR' THEN do
- XRed = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,8)
- end
- if LEFT(arg,3)='XGG' THEN do
- XGreen = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,9)
- end
- if LEFT(arg,3)='XBB' THEN do
- XBlue = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,10)
- end
- if LEFT(arg,3)='XBR' THEN do
- XBright = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,11)
- end
- if LEFT(arg,3)='XCC' THEN do
- XContrast = RIGHT(arg,LENGTH(arg)-5)
- CALL ActivateGadget(host,12)
- end
- if LEFT(arg,3)='XGM' THEN XGamma = RIGHT(arg,LENGTH(arg)-5)
-
- if arg=CLOSEWINDOW then do
- CALL CloseWindow(host)
- EXIT
- end
-
- if arg=OK THEN DO
- CALL CloseWindow(host)
- RETURN
- end
- end
- END
- RETURN
-
-
-
- /*
- remove all waiting messages from a port.
- */
-
- clearport:
- PARSE ARG portname
- p=1
- DO FOREVER
- p=GETPKT(portname)
- IF p='0000 0000'x THEN RETURN
- t=REPLY(p,0)
- END
- RETURN
-
-
- tofront:
- CALL ActivateWindow(host)
- CALL WindowToFront(host)
- CALL ScreenToFront(pscreen)
- RETURN
-
- /*
- Drawing a 3D rectangle...
- */
-
- box:
- ARG boxhost,pen1,pen2,upleft,uptop,width,height
- CALL SetAPen(boxhost,pen2)
- CALL Move(boxhost,upleft+width+1,uptop)
- CALL Draw(boxhost,upleft+width+1,uptop+height)
- CALL Draw(boxhost,upleft-1,uptop+height)
- CALL Move(boxhost,upleft+width,uptop+1)
- CALL Draw(boxhost,upleft+width,uptop+height)
- CALL SetAPen(boxhost,pen1)
- CALL Move(boxhost,upleft,uptop)
- CALL Draw(boxhost,upleft+width,uptop)
- CALL Move(boxhost,upleft,uptop+height-1)
- CALL Draw(boxhost,upleft,uptop)
- CALL Move(boxhost,upleft-1,uptop)
- CALL Draw(boxhost,upleft-1,uptop+height)
- RETURN
-
-
-
- /*
- Creates a place where messages can be recieved by rexxarplib
- and acted upon.
- */
-
- setup_host:
- CALL OPENPORT(port)
- ADDRESS AREXX "'x=CreateHost("host","port","pscreen")'"
- DO 200 WHILE ~SHOW('Ports',host)
- CALL DELAY 10 /* 200 ms */
- END
- IF ~SHOW('Ports',host) THEN
- CALL ALL_DONE('Could not open host 'host'.')
- IF ~SHOW('Ports',port) THEN
- CALL ALL_DONE('Could not open port 'port'.')
- RETURN
-
- /*
- initialize
- */
-
- setup_variables:
- success=open(PrefsFile,'ADProScripts:F0.config','R')
- if success=0 then CALL DefaultSettings()
- else do
- flag=0
- flag1=0
- LockedItemFlag=readln(PrefsFile)
- RequesterItemFlag=readln(PrefsFile)
- IMAGELOADFORMAT=readln(PrefsFile)
- IMAGESAVEFORMAT=readln(PrefsFile)
- ABSSC_X=readln(PrefsFile)
- ABSSC_Y=readln(PrefsFile)
- DITHERING=readln(PrefsFile)
- HIRES=readln(PrefsFile)
- INTERLACE=readln(PrefsFile)
- HOVERSCAN=readln(PrefsFile)
- VOVERSCAN=readln(PrefsFile)
- OPERATORNAME=readln(PrefsFile)
- COLORNR=readln(PrefsFile)
- success=close(PrefsFile)
- end
- RETURN
-
- DefaultSettings:
- IMAGELOADFORMAT='UNIVERSAL'
- IMAGESAVEFORMAT='IFF'
- ABSSC_X=-1
- ABSSC_Y=-1
- DITHERING=0
- HIRES=0
- INTERLACE=0
- HOVERSCAN=0
- VOVERSCAN=0
- OPERATORNAME='NONE'
- COLORNR='HAM'
- LockedItemFlag=1
- RequesterItemFlag=1
- flag=0
- flag1=0
- RETURN
- /* */
-