DEFLNG a-z

$INCLUDE "e:\bme\cgi\PBCGI.INC"
$INCLUDE "e:\bme2\engine\iam\iam.inc"
$INCLUDE "e:\bme2\engine\iam\multpart.inc"

'IAMGC.BAS - Image conversion tool (really quick'n'dirty)

'Note for those looking at this sourcecode for education/entertainment:
' PBCGI.INC is an include for for accessing IIS/CGI data. ToPut$ is also used, which URI-encodes a string.
' MULTPART.INC is a small CGI add-on for parsing multi-part form data. It's a bit brute force.
' IAM.INC contains the output routine (WriteError) used to contain most of the forms. It also contains some directory names, etc.

'The imaging library used is from SMALLER ANIMALS.

'Local
DECLARE FUNCTION SuckIn$ (theFile$)      ' Quickly pull in file

'Windows
DECLARE FUNCTION GlobalUnlock LIB "KERNEL32.DLL" ALIAS "GlobalUnlock" (BYVAL hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalLock LIB "KERNEL32.DLL" ALIAS "GlobalLock" (BYVAL hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalFree LIB "KERNEL32.DLL" ALIAS "GlobalFree" (BYVAL hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalAlloc LIB "KERNEL32.DLL" ALIAS "GlobalAlloc" (BYVAL wFlags AS DWORD, BYVAL dwBytes AS DWORD)

'Isource
DECLARE SUB      ISInitialize     LIB "_ISource22.DLL" ALIAS "_ISInitialize" (BYVAL pKey$)
DECLARE FUNCTION ISOpenFileSource LIB "_ISource22.dll" ALIAS "_ISOpenFileSource" (BYVAL pFileName AS STRING) AS LONG
DECLARE FUNCTION ISReadPSD        LIB "_ISource22.dll" ALIAS "_ISReadPSD" (BYVAL hSource AS LONG, BYREF puWidth AS LONG, BYREF puHeight AS LONG, BYVAL uColorType AS LONG, BYVAL fGammaVal AS DOUBLE) AS LONG
DECLARE FUNCTION ISReadTIFF       LIB "_ISource22.dll" ALIAS "_ISReadTIFF" (BYVAL hSource AS LONG, BYREF puWidth AS LONG, BYREF puHeight AS LONG, BYVAL uColorType AS LONG, BYVAL fGammaVal AS DOUBLE, BYREF uFrameIndex AS LONG) AS LONG
DECLARE FUNCTION ISCloseSource    LIB "_ISource22.dll" ALIAS "_ISCloseSource" (BYVAL hSource AS LONG) AS LONG
DECLARE FUNCTION ISResizeFilterImage LIB "_ISource22.dll" ALIAS "_ISResizeFilterImage" (BYVAL pRGB, BYVAL uSrcWidth, BYVAL uSrcHeight, BYVAL pRGBOut, BYVAL uDestWidth, BYVAL uDestHeight, BYVAL uBytesPerPixel, BYVAL uFilter)

'IMGDLL
DECLARE SUB      ImgDLLInitDLL         LIB "IMGDLL.DLL" ALIAS "ImgDLLInitDLL"        (BYVAL InitVal AS LONG)
DECLARE FUNCTION ImgDLLReadRGBFromBMP  LIB "IMGDLL.DLL" ALIAS "ImgDLLReadRGBFromBMP" (FileName AS ASCIIZ, iWidth AS LONG, iHeight AS LONG) AS LONG
DECLARE FUNCTION ImgDLLReadRGBFromJPG  LIB "IMGDLL.DLL" ALIAS "ImgDLLReadRGBFromJPG" (FileName AS ASCIIZ, iWidth AS LONG, iHeight AS LONG) AS LONG
DECLARE FUNCTION ImgDLLReadRGBFromGIF  LIB "IMGDLL.DLL" ALIAS "ImgDLLReadRGBFromGIF" (FileName AS ASCIIZ, iWidth AS LONG, iHeight AS LONG, pTransColor AS LONG) AS LONG
DECLARE FUNCTION ImgDLLReadRGBFromPNG  LIB "IMGDLL.DLL" ALIAS "ImgDLLReadRGBFromPNG" (FileName AS ASCIIZ, iWidth AS LONG, iHeight AS LONG) AS LONG
DECLARE FUNCTION ImgDLLReadRGBFromTIFF LIB "IMGDLL.DLL" ALIAS "ImgDLLReadRGBFromTIFF"(FileName AS ASCIIZ, iWidth AS LONG, iHeight AS LONG) AS LONG
DECLARE FUNCTION ImgDLLSaveRGBToJPG    LIB "IMGDLL.DLL" ALIAS "ImgDLLSaveRGBToJPG" (FileName AS ASCIIZ, BYVAL pBuf AS LONG PTR, BYVAL iWidth AS LONG, BYVAL iHeight AS LONG, BYVAL iQuality AS LONG, BYVAL bColor AS LONG, BYVAL bProgressive AS LONG) AS LONG

%MAXGCIMGSIZE = 5000   'maximum image size

FUNCTION PBMAIN()

   ON ERROR GOTO fail
   RANDOMIZE TIMER
   Inn$=cgiRead()
   cmd$ = GrabCGI$(inn$, "cmd")

   IF cmd$ = "" OR cmd$ = "full" THEN       'Write main form
      frm$ = "This tool allows you to convert various graphic files into web-suitable JPG images. You can try using this if your scanning software forces you to use BMP or TIFF files, or your digital camera makes giant images that you need to reduce.<p>"
      frm$ = frm$ & "<form enctype=""multipart/form-data"" method=post action=""iamgc.exe"">"
      frm$ = frm$ & "<input type=hidden name=""cmd"" value=""convert"">"
      frm$ = frm$ & "<b>1. Please first select the image on your computer that you'd like to have converted, and, if you know it, tell me the file format (or just let me auto-detect it).</b><br>"
      frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Input file: <input type=""file"" name=""image"" size=""45""><br>"
      frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Input file format: <select name=""formatin"">"
      frm$ = frm$ & "<option value=""auto"" selected>Auto-detect"
      frm$ = frm$ & "<option value=""bmp"">BMP"
      frm$ = frm$ & "<option value=""gif"">GIF"
      frm$ = frm$ & "<option value=""jpg"">JPG"
      frm$ = frm$ & "<option value=""png"">PNG"
      frm$ = frm$ & "<option value=""psd"">PSD"
      frm$ = frm$ & "<option value=""tif"">TIFF</select><p>"
      frm$ = frm$ & "<b>2. Now tell us how good you'd like the image to look. The higher a value you choose, the larger the resulting file, but the better it will look (assuming the original is good).</b><br>"
      IF cmd$ = "full" THEN
         frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Output file quality: <input type=""text"" name=""quality"" value=""80"" size=10> (10 - 95)<p>"
      ELSE
         frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Output file quality: <select name=""quality"">"
         frm$ = frm$ & "<option value=""15"">15% - Low to the max"
         frm$ = frm$ & "<option value=""30"">30% - Very low"
         frm$ = frm$ & "<option value=""50"">50% - Low"
         frm$ = frm$ & "<option value=""70"">70% - Medium"
         frm$ = frm$ & "<option value=""80"" selected>80% - High"
         frm$ = frm$ & "<option value=""90"">90% - Ultra-high</select><p>"
      END IF
      frm$ = frm$ & "<b>3. Finally, if you'd like us to downsize your image (useful if this is a giant file off a new digital camera), tell us the size you'd like here.</b><br>"
      IF cmd$ = "full" THEN
         frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Scale down to (width) pixels: <input type=""text"" name=""scale"" value=""0"" size=10> (0 for N/A, or 16 - 2048)<p>"
      ELSE
         frm$ = frm$ & "&nbsp;&nbsp;&nbsp;Scale down to (width) pixels:<select name=""scale"">"
         frm$ = frm$ & "<option value=""0"" selected>n/a (keep as is)"
         frm$ = frm$ & "<option value=""320"">320 - Webcam (low)"
         frm$ = frm$ & "<option value=""640"">640 - Webcam (high)"
         frm$ = frm$ & "<option value=""800"">800 - Large"
         frm$ = frm$ & "<option value=""1024"">1024 - Desktop-sized</select><p>"
      END IF
      frm$ = frm$ & "<hr size=1><center><input type=""submit"" value=""perform conversion""><hr size=1></center></form>"
      IF cmd$ = "" THEN
         frm$ = frm$ & "<center><p>Want more control over the options? <a href=""iamgc.exe?cmd=full"">Click here</a><p></center>"
      END IF
      WriteError "Image file format conversion tool", frm$, ""
      EXIT FUNCTION
   ELSEIF cmd$ = "init" THEN
      MKDIR $IAMWEBDIR & "scratch"
      MKDIR $IAMDATADIR & "scratch"
      WriteError "MKDIR", "OK: " & $IAMDATADIR & "scratch", ""
      EXIT FUNCTION
   END IF

   thisimage$ = GrabCGI$(inn$, "image")
   IF LEN(thisimage$) < 100 THEN
      WriteError "No file selected", "You don't appear to have uploaded a file to convert. Please select a file from your computer to convert (press back and try again).", ""
      EXIT FUNCTION
   END IF
   thisformat$ = GrabCGI$(inn$, "formatin")
   IF INSTR("bmp,gif,jpg,png,psd,tif,", thisformat$ & ",") = 0 OR LEN(thisformat$) <> 3 THEN    'assume autodetect
      ct = INSTR(thisImage$, "Content-Type:")
      IF ct > 0 THEN
         lb = INSTR(ct, thisImage$, $CRLF)
         thisImage$ = MID$(thisImage$, lb + 4)
      ELSE
         WriteError "Invalid file", "We are not having any luck analyzing the file you're sending us. If you this error is in error, please contact me (glider) directly about this.", ""
         EXIT FUNCTION
      END IF
      IF LEFT$(thisImage$, 2) = CHR$(&Hff, &Hd8) AND RIGHT$(thisImage$, 2) = CHR$(&Hff, &Hd9) THEN    'jpeg markers
         thisformat$ = "jpg"
      ELSEIF LEFT$(thisImage$, 4) = "GIF8" THEN    'GIF format?
         thisFormat$ = "gif"
      ELSEIF LEFT$(thisImage$, 8) = CHR$(137, 80, 78, 71, 13, 10, 26, 10) THEN    'PNG format?
         thisFormat$ = "png"
      ELSEIF LEFT$(thisImage$, 3) = "BMP" THEN     'BMP format?
         thisFormat$ = "bmp"
      ELSEIF LEFT$(thisImage$, 4) = "8BPS" THEN       'PSD file?
         thisFormat$ = "psd"
      ELSEIF LEFT$(thisImage$, 4) = "II" & CHR$(42, 0) OR LEFT$(thisImage$, 4) = "MM" & CHR$(42, 0) THEN           'TIFF format?
         thisFormat$ = "tif"
      END IF
      IF thisFormat$ = "" THEN      'uh oh, couldn't autodetect
         frm$ = "We couldn't automatically identify your file format. Only BMP, GIF, JPG, PNG, PSD, and TIFF can be processed. If your file is in one of these formats, but wasn't automatically"
         frm$ = frm$ & " detected, try manually selecting it. Sorry!"
         WriteError "Invalid file", frm$, ""
         EXIT FUNCTION
      END IF
   END IF
   thisquality = VAL(GrabCGI$(inn$, "quality"))
   IF thisquality < 10 THEN
      thisquality = 10
   ELSEIF thisquality > 95 THEN
      thisquality = 95
   END IF
   thisscale = VAL(GrabCGI$(inn$, "scale"))
   IF thisscale < 16 AND thisscale <> 0 THEN
      thisscale = 16
   ELSEIF thisscale > 2048 THEN
      thisscale = 2048
   END IF

   'Write to temp filename
   username$ = GetCookie$("IAMusername")
   IF username$ = "" THEN
      BaseDir$ = $IAMDATADIR & "scratch\"
      ctr = 0
      DO
         ctr = ctr + 1
         IF ctr = 500 THEN
            WriteError "Crash!", "Error: Couldn't generate random filename... Please report this!", ""
            EXIT FUNCTION
         END IF
         thisFile$ = BaseDir$ & FORMAT$(INT(RND*99999), "00000")
         IF DIR$(thisFile$) = "" THEN EXIT DO
      LOOP
   ELSE
      BaseDir$ = $IAMWEBDIR & "scratch\"
      thisFile$ = $IAMWEBDIR & "scratch\" & toPut$(username$) & ".jpg"
   END IF
   OPEN thisFile$ FOR OUTPUT AS #1
   PRINT #1, thisImage$;
   CLOSE #1

   'Load file
   ImgDLLInitDLL %IMGDLLINIT             'Initialize ImgDLL (used for GIF loading primarily)
   ISInitialize $ISDLLINIT       'Initialize iSource
   DIM zFile AS ASCIIZ * 256
   zFile = thisFile$
   SELECT CASE thisFormat$
      CASE "bmp"
         hRGB = ImgDLLReadRGBFromBMP (zFile, iWidth, iHeight)
      CASE "jpg"
         hRGB = ImgDLLReadRGBFromJPG (zFile, iWidth, iHeight)
      CASE "gif"
         hRGB = ImgDLLReadRGBFromGIF (zFile, iWidth, iHeight, transcol)
      CASE "png"
         hRGB = ImgDLLReadRGBFromPNG (zFile, iWidth, iHeight)
      CASE "tif"
         sres = ISOpenFileSource(zFile)
         IF sres > 0 THEN
            hRGB = ISReadTIFF (sres, iWidth, iHeight, 24, pally, 1)
         END IF
      CASE "psd"
         sres = ISOpenFileSource(zFile)
         IF sres > 0 THEN
            hRGB = ISReadPSD (sres, iWidth, iHeight, 24, pally)
         END IF
   END SELECT
   IF iWidth < 1 OR iHeight < 1 THEN
      IF thisFormat$ = "tif" THEN
         thenote$ = "<p><b>TIFF FILE NOTE:</b> The following 8-bit and 24-bit TIFF variations are supported: uncompressed, jpeg compressed, and ZIP compressed. LZW compression is not supported for licensing reasons, sorry."
      ELSE
         thenote$ = ""
      END IF
      WriteError "Image error", "We were not able to decode your image file. Make sure it's one of our supported format, and try selecting the format manually. If that doesn't work, you're probably SOL with this tool. Sorry!" & thenote$, ""
      GOTO deletetemp
   END IF
   IF iWidth > %MAXGCIMGSIZE OR iHeight > %MAXGCIMGSIZE THEN
      WriteError "Image error", "Whoa! That picture is ginormous. We can't process stuff that big, sorry...", ""
      GOTO deletetemp
   END IF
   GlobalUnlock hRGB
   pBuf = GlobalLock(hRGB)

   'Scale if needed
   IF thisScale > 0 AND iWidth > thisScale THEN
      scaleAmt# = thisScale / iWidth
      iWidth2 = scaleAmt# * iWidth
      iHeight2 = scaleAmt# * iHeight
      pResized = GlobalAlloc(&H0, 3 * iWidth2 * iHeight2)
      res = ISResizeFilterImage (pBuf, iWidth, iHeight, pResized, iWidth2, iHeight2, 3, 8)
      IF res = 0 THEN
         WriteError "Image error", "An error occured while trying to convert your image (scaling problem). Please let me (glider) know about this, assuming your file is valid.", ""
         GOTO deletetemp
      END IF
      GlobalFree pBuf
      pBuf = pEffect
      iWidth = iWidth2
      iHeight = iHeight2
   ELSE
      hResized = hRGB
      pResized = GlobalLock (hResized)
   END IF

   'Resave file, clear variables, and output image data
   res = ImgDLLSaveRGBToJPG (zFile, pResized, iWidth, iHeight, thisQuality, 1, 0)
   IF res = 0 THEN
      WriteError "Image error", "An error occured while trying to convert your image (saving problem). Please let me (glider) know about this, assuming your file is valid.", ""
      GOTO deletetemp
   END IF

   x$ = SuckIn$(thisFile$)
   STDOUT "Content-type: image/jpeg"
   IF username$ <> "" THEN
      STDOUT "URI: " & $IAMBASEURL & "scratch/" & toPut$(username$) & ".jpg" & $CRLF
   ELSE
      STDOUT $CRLF & x$;
   END IF

   'Delete temp filename
deletetemp:
   IF thisFormat$ = "tif" OR thisFormat$ = "psd" THEN
      res = ISCloseSource(sres)
   END IF
   IF username$ = "" AND DIR$(thisFile$) <> "" THEN
      KILL thisFile$
   END IF

   GlobalUnlock hRGB
   GlobalFree hRGB
   GlobalUnlock hResized
   GlobalFree hResized

   EXIT FUNCTION
fail:
   WriteCGI "<p>"
   WriteCGI "ERROR: Code# " & FORMAT$(ERR) & "<p>"
   EXIT FUNCTION
END FUNCTION


FUNCTION SuckIn$ (theFile$)      ' Quickly pull in file
   x$ = DIR$(theFile$)
   IF x$ = "" THEN
      SuckIn$ = ""
      EXIT FUNCTION
   END IF
   ff = FREEFILE
   OPEN theFile$ FOR BINARY LOCK SHARED AS #ff
   GET$ #ff, LOF(ff), Buffer$
   CLOSE #ff
   SuckIn$ = Buffer$
   EXIT FUNCTION
END FUNCTION