home *** CD-ROM | disk | FTP | other *** search
/ World of Graphics / WOGRAPH.BIN / 330.VISAGE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-10  |  15KB  |  570 lines
  1. {
  2. *****************************************************************************
  3. *   Copyright (c) DIDC, 1991, 1992.  All rights reserved.                   *
  4. *   Unauthorized use, duplication, or distribution is strictly prohibited.  *
  5. *****************************************************************************
  6. }
  7. {$F+}
  8. Unit VISAGE;
  9.  
  10. (************************************************************************)
  11. Interface
  12. (************************************************************************)
  13.  
  14. Uses Dos,CRT;
  15.  
  16. function DIDC_locate_tsr : boolean;
  17.  
  18. function DIDC_total_pages(var dbname : string;
  19.                           var kname : string) : integer;
  20.  
  21. function DIDC_total_pages_type(var dbname : string;
  22.                                var kname : string;
  23.                                doc_type : integer) : integer;
  24.  
  25. function DIDC_call_menu(var dbname : string;
  26.                         var kname : string;
  27.                         flag : integer;
  28.                         var DocListFname : string) : Integer;
  29.  
  30. function DIDC_tsr_type : integer;
  31.  
  32. function DIDC_batch_update :  integer;
  33.  
  34. function DIDC_set_write_vol(wv : word) : integer;
  35.  
  36. function DIDC_clear_doc_page : integer;
  37.  
  38. function DIDC_unique_key(var dbfname : string;
  39.                          var key : string;
  40.                          len : integer) : integer;
  41.  
  42. function DIDC_get_write_vol : integer;
  43.  
  44. function DIDC_show_luns : integer;
  45.  
  46. function DIDC_scan_page(var dbname : string;
  47.                         var kname : string;
  48.                         page_type : integer) : Integer;
  49.  
  50. function DIDC_auto_scan(var dbname : string;
  51.                         var kname : string;
  52.                         page_type : integer) : Integer;
  53.  
  54. function DIDC_set_scanner(page_len : integer;
  55.                           source : integer;
  56.                           intensity : integer) : integer;
  57.  
  58. function DIDC_insert_page(var dbname : string;
  59.                           var kname : string;
  60.                           page_type : integer;
  61.                           page_num  : integer) : Integer;
  62.  
  63. function DIDC_delete_page(var dbname : string;
  64.                           var kname : string;
  65.                           page_type : integer;
  66.                           page_num  : integer) : Integer;
  67.  
  68. function DIDC_get_scanner(param : integer) : Integer;
  69.  
  70. function DIDC_save_scan_set : Integer;
  71.  
  72. function DIDC_print_all_pages_type(var dbname : string;
  73.                                    var kname : string;
  74.                                    doctype : integer) : integer;
  75.  
  76. function DIDC_print_pages(var dbname : string;
  77.                           var kname : string;
  78.                           doctype : integer;
  79.                           first_page : integer;
  80.                           last_page : integer) : integer;
  81.  
  82.  
  83. function DIDC_display_page(var dbname : string;
  84.                            var kname : string;
  85.                            pagetype, page : integer;
  86.                            control : integer) : Integer;
  87.  
  88. procedure checkkf9200;
  89.  
  90. (************************************************************************)
  91. IMPLEMENTATION
  92. (************************************************************************)
  93.  
  94. type
  95.   stype = array[0..50] of char;
  96.  
  97. var
  98.   DTIregs : Registers;
  99.   res     : longint;
  100.   DTIint  : word;
  101.   params  : ^stype;
  102.   strng : string;
  103.  
  104. const
  105.   DTI_TIMEOUT : integer = -555;
  106.   MAX_RETRY : integer = 10;
  107.  
  108. (************************************************************************)
  109.  
  110. function dti_done : boolean;
  111. begin
  112. if (params^[0] = chr(0)) then
  113.   dti_done  := true
  114. else
  115.   dti_done  := false;
  116. end;
  117.  
  118. (************************************************************************)
  119.  
  120. function DIDC_result : integer;
  121. var
  122.   i : integer;
  123. begin
  124. move(params^[1],i,2);
  125. DIDC_result  := i;
  126. end;
  127.  
  128. (************************************************************************)
  129.  
  130. procedure write_params(s : string);
  131. var
  132.   i : integer;
  133. begin
  134. for i  := 1 to length(s) do
  135.   params^[i-1]  := upcase(s[i]);
  136. params^[i]  := chr(0);
  137. end;
  138.  
  139. (************************************************************************)
  140.  
  141. function DIDC_call_tsr(var s : string) : integer;
  142. var
  143.   retry : integer;
  144. begin
  145. if (DTIint = 0) then
  146.   begin
  147.   DIDC_call_tsr  := 0;
  148.   exit;
  149.   end;
  150.  
  151. for retry  := 1 to MAX_RETRY do
  152.   begin
  153.   DTIregs.ax  := 1;
  154.   write_params(s);
  155.   Intr(DTIint,DTIregs);
  156.   delay(100);
  157.   if dti_done then
  158.     begin
  159.     DIDC_call_tsr  := DIDC_result;
  160.     exit;
  161.     end;
  162.   end;
  163. DIDC_call_tsr  := DTI_TIMEOUT;
  164. end;
  165.  
  166. (************************************************************************)
  167.  
  168. function hexval(c : char) : integer;
  169. begin
  170.   case upcase(c) of
  171.   '0' : hexval  := 0;
  172.   '1' : hexval  := 1;
  173.   '2' : hexval  := 2;
  174.   '3' : hexval  := 3;
  175.   '4' : hexval  := 4;
  176.   '5' : hexval  := 5;
  177.   '6' : hexval  := 6;
  178.   '7' : hexval  := 7;
  179.   '8' : hexval  := 8;
  180.   '9' : hexval  := 9;
  181.   'A' : hexval  := 10;
  182.   'B' : hexval  := 11;
  183.   'C' : hexval  := 12;
  184.   'D' : hexval  := 13;
  185.   'E' : hexval  := 14;
  186.   'F' : hexval  := 15;
  187.   end;
  188. end;
  189.  
  190. (************************************************************************)
  191.  
  192. function hexconv(s : string) : integer;
  193. begin
  194. hexconv  := hexval(s[1])*16 + hexval(s[2]);
  195. end;
  196.  
  197. (************************************************************************)
  198.  
  199. function DIDC_locate_tsr : boolean;
  200. type
  201.   addr  = array[1..2] of word;
  202.   aa_type = array[1..20] of char;
  203. var
  204.   a : ^addr;
  205.   s,o : word;
  206.   aa : ^aa_type;
  207.   i,j : integer;
  208. begin
  209.  
  210. for j  := $60 to $67 do
  211.   begin
  212.   {writeln(j);}
  213.   a  := ptr(0,j*4);
  214.   s  := a^[2];
  215.   o  := a^[1];
  216.   {writeln('s = ',s,' o = ',o);}
  217.  
  218.   if (s > 0) then
  219.   for i  := 1 to 5 do
  220.     begin
  221.     aa  := ptr(s,o);
  222.     if (aa^[1] = 'P') and
  223.        (aa^[2] = 'Q') and
  224.        (aa^[3] = 'R') and
  225.        (aa^[4] = 'S') and
  226.        (aa^[5] = 'T') and
  227.        (aa^[6] = 'U') then
  228.       begin
  229.       DTIregs.ax  := 0;
  230.       Intr(j,DTIregs);
  231.       {
  232.       writeln(DTIregs.cx,'  ',DTIregs.dx);
  233.       readln;
  234.       }
  235.       params  := ptr(DTIregs.cx,DTIregs.dx);
  236.       DIDC_locate_tsr  := true;
  237.       DTIint  := j;
  238.       exit;
  239.       end;
  240.     o  := o + 1;
  241.     end;
  242.   end;
  243. DIDC_locate_tsr  := false;
  244. DTIint  := 0;
  245. end;
  246.  
  247. (************************************************************************)
  248. (* General functions                                                    *)
  249. (************************************************************************)
  250.  
  251. function DIDC_total_pages(var dbname : string;
  252.                           var kname : string) : integer;
  253. begin
  254. (* function 001 *)
  255. strng  := '1 '+dbname+' '+kname;
  256. DIDC_total_pages  := DIDC_call_tsr(strng);
  257. end;
  258.  
  259. (************************************************************************)
  260.  
  261. function DIDC_total_pages_type(var dbname : string;
  262.                                var kname : string;
  263.                                doc_type : integer) : integer;
  264. var
  265.   s : string[20];
  266. begin
  267. (* function 002 *)
  268. str(doc_type,s);
  269.  
  270. strng  := '2 '+dbname+' '+kname+' '+s;
  271. DIDC_total_pages_type  := DIDC_call_tsr(strng);
  272. end;
  273.  
  274. (************************************************************************)
  275.  
  276. function DIDC_call_menu(var dbname : string;
  277.                         var kname : string;
  278.                         flag : integer;
  279.                         var DocListFname : string) : Integer;
  280. const
  281.   NO_DB_NAME = -561;
  282.   EMPTY_KEY  = -559;
  283. var
  284.   s : string[20];
  285.  
  286. Begin
  287. (* function 003 *)
  288.  
  289.  
  290. if (length(dbname) = 0) then
  291.   begin
  292.   DIDC_call_menu := NO_DB_NAME;
  293.   exit;
  294.   end;
  295.  
  296. if (length(kname) = 0) then
  297.   begin
  298.   DIDC_call_menu := EMPTY_KEY;
  299.   exit;
  300.   end;
  301.  
  302.  
  303. str(flag,s);
  304. strng  := '3 '+dbname+' '+kname+' '+s+' '+DocListFname;
  305. DIDC_call_menu  := DIDC_call_tsr(strng);
  306. End;
  307.  
  308. (************************************************************************)
  309.  
  310. function DIDC_tsr_type : integer;
  311. begin
  312. (* function 004 *)
  313. strng  := '4';
  314. DIDC_tsr_type  := DIDC_call_tsr(strng);
  315. end;
  316.  
  317. (************************************************************************)
  318.  
  319. function DIDC_batch_update :  integer;
  320. (* function 005 *)
  321. begin
  322. strng  := '5';
  323. DIDC_batch_update  := DIDC_call_tsr(strng);
  324. end;
  325.  
  326. (************************************************************************)
  327.  
  328. function DIDC_set_write_vol(wv : word) : integer;
  329. (* function 006 *)
  330. var
  331.   s : string[30];
  332. begin
  333. str(wv,s);
  334. strng  := '6 '+s;
  335. write_params(strng);
  336. DIDC_set_write_vol := DIDC_call_tsr(strng);
  337. end;
  338.  
  339. (************************************************************************)
  340.  
  341. function DIDC_clear_doc_page : integer;
  342. (* function 007 *)
  343. begin
  344. strng  := '7';
  345. DIDC_clear_doc_page  := DIDC_call_tsr(strng);
  346. end;
  347.  
  348. (************************************************************************)
  349.  
  350. function DIDC_unique_key(var dbfname : string;
  351.                          var key : string;
  352.                          len : integer) : integer;
  353. (* function 008 *)
  354. var
  355.   i,j : integer;
  356.   c : char;
  357.   s : string[20];
  358. begin
  359. str(len,s);
  360. strng  := '8 '+dbfname+' '+s;
  361. i  := DIDC_Call_Tsr(strng);
  362.  
  363.  
  364. j  := 3;
  365. if (i = 0) then
  366.   begin
  367.   move(params^[j],c,1);
  368.   key  := '';
  369.   while (c > #0) do
  370.     begin
  371.     key  := key + c;
  372.     j  := j + 1;
  373.     move(params^[j],c,1);
  374.     end;
  375.   end;
  376.  
  377. DIDC_Unique_Key  := i;
  378. end;
  379.  
  380. (************************************************************************)
  381.  
  382. function DIDC_get_write_vol : integer;
  383. begin
  384. (* function 010 *)
  385. strng  := '10';
  386. DIDC_get_write_vol  := DIDC_call_tsr(strng);
  387. end;
  388.  
  389. (************************************************************************)
  390.  
  391. function DIDC_show_luns : integer;
  392. begin
  393. (* function 011 *)
  394. strng  := '11';
  395. DIDC_show_luns := DIDC_call_tsr(strng);
  396. end;
  397.  
  398. (************************************************************************)
  399. (* Scan functions                                                       *)
  400. (************************************************************************)
  401.  
  402. function DIDC_scan_page(var dbname : string;
  403.                         var kname : string;
  404.                         page_type : integer) : Integer;
  405. var
  406.  s : string[10];
  407. Begin
  408. str(page_type,s);
  409. strng  := '101 '+dbname+' '+kname+' '+s;
  410. DIDC_scan_page  := DIDC_call_tsr(strng);
  411. End;
  412.  
  413. (************************************************************************)
  414.  
  415. function DIDC_auto_scan(var dbname : string;
  416.                         var kname : string;
  417.                         page_type : integer) : Integer;
  418. var
  419.  s : string[10];
  420. Begin
  421. str(page_type,s);
  422. strng  := '102 '+dbname+' '+kname+' '+s;
  423. DIDC_auto_scan  := DIDC_call_tsr(strng);
  424. End;
  425.  
  426. (************************************************************************)
  427.  
  428. function DIDC_set_scanner(page_len : integer;
  429.                           source : integer;
  430.                           intensity : integer) : integer;
  431. var
  432.   s1,s2,s3 : string[20];
  433. begin
  434. (* function 103 *)
  435. str(page_len,s1);
  436. str(source,s2);
  437. str(intensity,s3);
  438. strng  := '103 '+s1+' '+s2+' '+s3;
  439. DIDC_set_scanner := DIDC_call_tsr(strng);
  440. end;
  441.  
  442. (************************************************************************)
  443.  
  444. function DIDC_insert_page(var dbname : string;
  445.                           var kname : string;
  446.                           page_type : integer;
  447.                           page_num  : integer) : Integer;
  448. var
  449.   s1,s2 : string[20];
  450. begin
  451. (* function 104 *)
  452. str(page_type,s1);
  453. str(page_num,s2);
  454. strng  := '104 '+dbname+' '+kname+' '+s1+' '+s2;
  455. DIDC_insert_page  := DIDC_call_tsr(strng);
  456. end;
  457.  
  458. (************************************************************************)
  459.  
  460. function DIDC_delete_page(var dbname : string;
  461.                           var kname : string;
  462.                           page_type : integer;
  463.                           page_num  : integer) : Integer;
  464. var
  465.   s1,s2 : string[20];
  466. begin
  467. (* function 105 *)
  468. str(page_type,s1);
  469. str(page_num,s2);
  470. strng  := '105 '+dbname+' '+kname+' '+s1+' '+s2;
  471. DIDC_delete_page  := DIDC_call_tsr(strng);
  472. end;
  473.  
  474. (************************************************************************)
  475.  
  476. function DIDC_get_scanner(param : integer) : Integer;
  477. var
  478.   s1 : string[20];
  479. begin
  480. (* function 106 *)
  481. str(param,s1);
  482. strng  := '106 '+s1;
  483. DIDC_get_scanner  := DIDC_call_tsr(strng);
  484. end;
  485.  
  486. (************************************************************************)
  487.  
  488. function DIDC_save_scan_set : Integer;
  489. begin
  490. (* function 107 *)
  491. strng  := '107';
  492. DIDC_save_scan_set  := DIDC_call_tsr(strng);
  493. end;
  494.  
  495.  
  496. (************************************************************************)
  497. (* Print functions                                                      *)
  498. (************************************************************************)
  499.  
  500. function DIDC_print_all_pages_type(var dbname : string;
  501.                                    var kname : string;
  502.                                    doctype : integer) : integer;
  503. var
  504.   s1 : string[20];
  505. begin
  506. (* function 201 *)
  507. str(doctype,s1);
  508.  
  509. strng  := '201 '+dbname+' '+kname+' '+s1;
  510. DIDC_print_all_pages_type  := DIDC_call_tsr(strng);
  511. end;
  512.  
  513. (************************************************************************)
  514.  
  515. function DIDC_print_pages(var dbname : string;
  516.                           var kname : string;
  517.                           doctype : integer;
  518.                           first_page : integer;
  519.                           last_page : integer) : integer;
  520. var
  521.   s1,s2,s3 : string[20];
  522. begin
  523. str(doctype,s1);
  524. str(first_page,s2);
  525. str(last_page,s3);
  526.  
  527. strng  := '203 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
  528. DIDC_print_pages  := DIDC_call_tsr(strng);
  529. end;
  530.  
  531. (************************************************************************)
  532. (* Display Functions                                                    *)
  533. (************************************************************************)
  534.  
  535. function DIDC_display_page(var dbname : string;
  536.                            var kname : string;
  537.                            pagetype, page : integer;
  538.                            control : integer) : Integer;
  539. var
  540.   s1,s2,s3 : string[30];
  541. (* function 300 *)
  542. begin
  543. str(pagetype,s1);
  544. str(page,s2);
  545. str(control,s3);
  546.  
  547. strng  := '300 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
  548. DIDC_display_page  := DIDC_call_tsr(strng);
  549. end;
  550.  
  551. (************************************************************************)
  552.  
  553. procedure checkkf9200;
  554. begin
  555. if not DIDC_locate_tsr then
  556.   begin
  557.   writeln('VISAGE is not loaded.');
  558.   writeln('You will not be able to access images...');
  559.   readln;
  560.   end;
  561. end;
  562.  
  563. (************************************************************************)
  564.  
  565. begin
  566. checkkf9200;
  567. end.
  568.  
  569.  
  570.