home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XLABEL.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  5.9 KB  |  232 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.         Label printing
  7. ****************************************************************/
  8.  
  9. code=2500
  10.  
  11. include "tdoms.pro"
  12.  
  13. DOMAINS
  14.   FNAME=SYMBOL
  15.   TYPE = int(); str(); real()
  16.   FILE = myprinter
  17.  
  18. DATABASE
  19.   /* Database declarations used in SCRHND.PRO */
  20.   insmode            /* Global insertmode */
  21.   actfield(FNAME)        /* Actual field */
  22.   screen(SYMBOL,DBASEDOM)    /* Saving different screens */
  23.   value(FNAME,STRING)        /* value of a field */
  24.   field(FNAME,TYPE,ROW,COL,LEN) /* Screen definition */
  25.   txtfield(ROW,COL,LEN,STRING)
  26.   windowsize(ROW,COL).
  27.   notopline
  28.  
  29.   /* Database declarations used in VSCRHND.PRO */
  30.   windowstart(ROW,COL)
  31.   mycursord(ROW,COL)
  32.  
  33.   /* Database declarations used in LINEINP.PRO */
  34.   lineinpstate(STRING,COL)
  35.   lineinpflag
  36.  
  37.   label(STRING)
  38.   dbstrike
  39.   font(INTEGER)
  40.   printer(STRING)
  41.  
  42. include "status.pro"
  43. include "tpreds.pro"
  44. include "menu.pro"
  45. include "lineinp.pro"
  46. include "filename.pro"
  47. include "scrhnd.pro"
  48.  
  49. /*******************************************************************
  50.         Internal Predicates
  51. *******************************************************************/
  52.  
  53. PREDICATES
  54.   displbl
  55.   printlabels
  56.   change(DBASEDOM)
  57.   filename(STRING)
  58.   rdfile(STRING,STRING)
  59.   index(INTEGER,STRINGLIST,STRING)
  60.   nondeterm fonttext(INTEGER,STRING)
  61.   nondeterm printers(STRING)
  62.   nondeterm member(STRING,STRINGLIST)
  63.   nondeterm for(INTEGER,INTEGER,INTEGER)
  64.   write_n(INTEGER,CHAR)
  65.   str_lines(STRING,STRINGLIST)
  66.   setprintercodes
  67.   printlabel(STRINGLIST)
  68.   printercode(STRING)
  69.  
  70. CLAUSES
  71.   change(value(X,_)):-retract(value(X,_)),fail.
  72.   change(label(_)):-retract(label(_)),fail.
  73.   change(font(_)):-retract(font(_)),fail.
  74.   change(printer(_)):-retract(printer(_)),fail.
  75.   change(label(LBL)):-!,assert(label(LBL)),displbl.
  76.   change(X):-assert(X).
  77.  
  78.   displbl:-
  79.     label(LBL),!,
  80.     shiftwindow(5),
  81.     window_str(LBL),
  82.     shiftwindow(1).
  83.  
  84.   filename(FILENAME):-
  85.     value(file,FNAME),!,
  86.     cursor(ROW,COL),R1=ROW+2,
  87.     readfilename(R1,COL,23,23,lbl,FNAME,FILENAME),
  88.     change(value(file,FILENAME)).
  89.  
  90.   rdfile(FILENAME,LABEL):-
  91.     file_str(FILENAME,LABEL),!.
  92.   rdfile(FILENAME,_):-
  93.       makewindow(1,23,23,"",5,20,4,45),
  94.     write(">> File not found: ",FILENAME),
  95.     readkey(_),removewindow,fail.
  96.  
  97.   fonttext(1,"Fast").  fonttext(2,"Medium").  fonttext(3,"Quality").
  98.  
  99.   printers(prn).  printers(com1).  printers(com2).
  100.  
  101.   printlabels:-
  102.     label(LBL),str_lines(LBL,LIST),
  103.     printer(PRINTER),
  104.     value(number,NN),str_int(NN,NOOFLABELS),
  105.     openwrite(myprinter,PRINTER),
  106.     writedevice(myprinter),
  107.     setprintercodes,
  108.     for(I,0,NOOFLABELS),
  109.     printlabel(LIST),
  110.     I>=NOOFLABELS-1,!,
  111.     closefile(myprinter).
  112.  
  113.   printlabel(LIST):-
  114.     value(indent,NN),str_int(NN,N),
  115.     member(LINE,LIST),
  116.     write_n(N,' '),write(LINE),nl,
  117.     fail.
  118.   printlabel(LIST):-
  119.     listlen(LIST,LEN),
  120.     value(labellines,TT),str_int(TT,TOT),!,
  121.     SKIP=TOT-LEN,
  122.     write_n(SKIP,'\n').
  123.  
  124.   setprintercodes:-
  125.     value(initcode,INIT),
  126.     printercode(INIT),fail.
  127.   setprintercodes:-
  128.     dbstrike,
  129.     value(dbstrikecode,DBSTRIKE),
  130.     printercode(DBSTRIKE),fail.
  131.   setprintercodes:-
  132.     font(N),str_int(NO,N),
  133.     concat("font",NO,FRONT),
  134.     value(FRONT,FRONTCODE),
  135.     printercode(FRONTCODE),fail.
  136.   setprintercodes.
  137.  
  138.   printercode(""):-!.
  139.   printercode(CODE):-
  140.     frontchar(CODE,'\\',REST),
  141.     fronttoken(REST,NUM,RESTCODE),
  142.     str_int(NUM,CHI),
  143.     char_int(CH,CHI),
  144.     write(CH),!,
  145.     printercode(RESTCODE).
  146.   printercode(CODE):-
  147.     frontchar(CODE,CH,REST),
  148.     write(CH),
  149.     printercode(REST).
  150.  
  151.   index(1,[H|_],H):-!.
  152.   index(N,[_|T],X):-N>1,N1=N-1,index(N1,T,X).
  153.  
  154.   member(X,[X|_]).
  155.   member(X,[_|L]):-member(X,L).
  156.  
  157.   for(I,I,_).
  158.   for(I,A,B):-B>A,A1=A+1,for(I,A1,B).
  159.  
  160.   write_n(0,_):-!.
  161.   write_n(N,CH):-N>0,write(CH),N1=N-1,write_n(N1,CH).
  162.  
  163.   str_lines("",[]):-!.
  164.   str_lines(STR,[H|T]):-
  165.     search_char('\n',STR,0,N),
  166.     frontstr(N,STR,H,R),
  167.     frontchar(R,_,R1),!,
  168.     str_lines(R1,T).
  169.   str_lines(STR,[STR]).
  170.  
  171.  
  172. /****************************************************************
  173.         Screen handling predicates
  174. ****************************************************************/
  175.  
  176.   noinput(load).    noinput(save).        noinput(saveconfig).
  177.   noinput(print).    noinput(printer).    noinput(font).
  178.   noinput(edit).    noinput(dir).        noinput(dbstrike).
  179.  
  180.   field_action(load):-
  181.     cursor(ROW,COL),R1=ROW+2,
  182.     readfilename(R1,COL,23,23,lbl,"",FILENAME),
  183.     rdfile(FILENAME,LABEL),
  184.     change(value(file,FILENAME)),
  185.     change(label(LABEL)).
  186.   field_action(save):-
  187.     filename(FILENAME),
  188.     label(LABEL),!,
  189.     file_str(FILENAME,LABEL).
  190.   field_action(edit):-
  191.     label(LABEL),
  192.     shiftwindow(5),
  193.     editmsg(LABEL,LABEL1,"edit","","",0,"",RET), 
  194.     shiftwindow(1),
  195.     refreshstatus,
  196.     RET><1,!,
  197.     change(label(LABEL1)).
  198.   field_action(edit):-displbl.
  199.   field_action(dir):-cursor(ROW,COL),setdir(ROW,COL,23,23).
  200.   field_action(file):-filename(_).
  201.   field_action(print):-printlabels.
  202.   field_action(dbstrike):-retract(dbstrike),!.
  203.   field_action(dbstrike):-assert(dbstrike).
  204.   field_action(font):-
  205.     cursor(ROW,COL),
  206.     findall(X,fonttext(_,X),LIST),
  207.     menu(ROW,COL,23,23,LIST,"Choose font",0,FRONT),
  208.     FRONT><0,
  209.     change(font(FRONT)).
  210.   field_action(printer):-
  211.     cursor(ROW,COL),
  212.     findall(X,printers(X),LIST),
  213.     menu(ROW,COL,23,23,LIST,"Choose printer",0,NR),
  214.     index(NR,LIST,PRINTER),
  215.     change(printer(PRINTER)).
  216.   field_action(saveconfig):-save("xlabel.dba").
  217.  
  218.   field_value(dir,DISK):-!,disk(DISK).
  219.   field_value(dbstrike,on):-dbstrike,!.
  220.   field_value(dbstrike,off):-!.
  221.   field_value(font,FRONT):-!,font(NR),fonttext(NR,FRONT),!.
  222.   field_value(printer,X):-!,printer(X),!.
  223.   field_value(FNAME,VAL):-value(FNAME,VAL),!.
  224.  
  225. GOAL    makewindow(5,66,67,"LABEL",15,0,9,80),
  226.     makewindow(1,32,33,"Label Printing",0,0,15,80),
  227.     makestatus(23," Move the cursor with the arrow keys and select by pressing RETURN"),
  228.     consult("xlabel.dba"),
  229.     displbl,
  230.     scrhnd(off,_).
  231.  
  232.