home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 117 / af117a.adf / archives / af117a1.lzx / Fiasco_2.2 / Databases / PictureDatabase / AddPicture.frx next >
Text File  |  1998-09-22  |  4KB  |  214 lines

  1. /* addpicture.frx
  2.  * Adds a new picture entry to Fiasco's picture database
  3.  * Copyright © 1996-1997 Nils Bandener
  4.  * $VER: addpicture_frx 6.4 (6.10.97)
  5.  */
  6.  
  7. Options Results
  8. Options Failat 21
  9. Parse Arg FileName
  10.  
  11. scriptname = "AddPicture"
  12.  
  13. fiasco_port = address()
  14.  
  15. Signal on Syntax
  16. Signal on Halt
  17. Signal on Break_C
  18. Signal on Failure
  19.  
  20. LockGUI
  21.  
  22. /*
  23.  * Constant values
  24.  */
  25.  
  26. DTFieldsInRecord = 8
  27.  
  28. if FileName = "" then
  29. do
  30.     /*
  31.      * if no name is given, request
  32.      * the name
  33.      */
  34.  
  35.     RequestFile 'Title "Select picture" Noicons ProjectRelative Var Filename'
  36. end
  37.  
  38. if FileName ~= "" then do
  39.  
  40.     CountRecords var numrecs
  41.  
  42.     /*
  43.      * Initialize these vars to
  44.      * remember the field and
  45.      * record number
  46.      */
  47.  
  48.     fieldnumber = 0
  49.     recordnumber = 0
  50.  
  51.     if numrecs > 0 then
  52.     do
  53.         do i = 1 to numrecs
  54.  
  55.             GetField "Cnt" Record i
  56.             cnt = result
  57.  
  58.             if result ~= DTFieldsInRecord then
  59.             do
  60.  
  61.                 k = 1
  62.  
  63.                 do while k <= DTFieldsInRecord & fieldnumber = 0
  64.  
  65.                     GetField "Name_" || k Record i
  66.  
  67.                     if result = "" then do
  68.  
  69.                         fieldnumber = k
  70.                         recordnumber = i
  71.  
  72.                     end
  73.  
  74.                     k = k + 1
  75.                 end
  76.             end
  77.         end
  78.     end
  79.  
  80.     if recordnumber = 0 | fieldnumber = 0 then
  81.     do
  82.         /*
  83.          * No record had a free field.
  84.          * Create a new record
  85.          */
  86.  
  87.         AddRecord record numrecs
  88.  
  89.         numrecs = numrecs + 1
  90.  
  91.         recordnumber = numrecs
  92.  
  93.         fieldnumber = 1
  94.  
  95.         cnt = 0
  96.     end
  97.  
  98.     GetField "Key" record recordnumber
  99.     Key = Result
  100.  
  101.     tnname = 'TN/TN_' || Key || '_' || Cnt
  102.  
  103.     /*
  104.      *  "__in_archive__" is a magic path component used
  105.      *  by ScanDir.rexx to seperate the dos path and the path
  106.      *  in an archive.
  107.      */
  108.  
  109.     archive = pos("/__in_archive__/", FileName)
  110.  
  111.     if archive ~= 0 then
  112.     do
  113.         ArcName = left(FileName, archive - 1)
  114.         NameInArc = substr(FileName, archive + 16)
  115.  
  116.         Address Command 'lha >nil: <nil: x "' || ArcName || '" "' || NameInArc || '" t:'
  117.  
  118.         if rc = 0 then
  119.         do
  120.             ExtractedName = "t:" || NameInArc
  121.             Address Command 'createthumbnail "' || ExtractedName || '" "' || tnname || '"'
  122.         end
  123.  
  124.         oldrc = rc  /* Preserve rc */
  125.         Address Command 'delete >nil: "' || ExtractedName || '" quiet'
  126.  
  127.         if pos("/", NameInArc) ~= 0 then
  128.         do
  129.             Address Command 'delete >nil: "t:' || substr(NameInArc, pos("/", NameInArc) - 1) || '" all'
  130.         end
  131.  
  132.         rc = oldrc
  133.     end
  134.     else
  135.     do
  136.         Address Command 'createthumbnail "' || FileName || '" "' || tnname || '"'
  137.     end
  138.  
  139.     if rc = 0 then
  140.     do
  141.         SetField "Name_" || fieldnumber Record recordnumber FileName
  142.  
  143.         SetField "DT_" || fieldnumber record recordnumber '"' || tnname || '"'
  144.  
  145.         cnt = cnt + 1
  146.  
  147.         SetField "Cnt" Record recordnumber cnt
  148.  
  149.         width = -1
  150.         height = -1
  151.         depth = -1
  152.         colors = -1
  153.  
  154.         if Open("f", "t:thumbnaildata", "read") then
  155.         do
  156.             l = ReadLn("f")
  157.  
  158.             parse var l "Width" width "Height" height "Depth" depth "Colors" colors
  159.  
  160.             call Close("f")
  161.         end
  162.  
  163.         SetField "Width_" || fieldnumber Record recordnumber width
  164.         SetField "Height_" || fieldnumber Record recordnumber height
  165.         SetField "Colors_" || fieldnumber Record recordnumber colors
  166.     end
  167. end
  168.  
  169. bail_out:
  170.  
  171. Address Value fiasco_port
  172.  
  173. UnlockGUI
  174. ResetStatus
  175.  
  176. exit
  177.  
  178. syntax:
  179. failure:
  180.  
  181. if show("Ports", fiasco_port) then
  182. do
  183.     Address Value fiasco_port
  184.  
  185.     RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title "' || scriptname || '"'
  186. end
  187. else
  188. do
  189.     say "Error" rc "in line" sigl ":" errortext(rc)
  190.     say "Enter to continue"
  191.     pull dummy
  192. end
  193.  
  194. call bail_out
  195.  
  196. halt:
  197. break_c:
  198.  
  199. if show("Ports", fiasco_port) then
  200. do
  201.     Address Value fiasco_port
  202.  
  203.     RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"'
  204. end
  205. else
  206. do
  207.     say "*** Break"
  208.     say "Enter to continue"
  209.     pull dummy
  210. end
  211.  
  212. call bail_out
  213.  
  214.