home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / snap / loadpic.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-17  |  5.7 KB  |  223 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      LOADPIC.PAS                       *)
  3. (*      Laden der mit SNAPSHOT abgespeicherten Screens    *)
  4. (* ------------------------------------------------------ *)
  5.  
  6. PROGRAM loadPic;
  7. (*$I REGS8088.INC *)
  8. (*$I SCREENIO.INC *)
  9.  
  10. TYPE extension          = STRING[3];
  11.      Line               = STRING[80];
  12.      index              = ARRAY[0..99] OF Line;
  13.  
  14. VAR lname, lindex, pfad : name;
  15.     a_x, a_y            : INTEGER;
  16.     lmodus, lseite      : BYTE;
  17.     ch                  : CHAR;
  18.     picindex            : index;
  19.     Tdatei              : TEXT;
  20.  
  21. (* ------------------------------------------------------ *)
  22. PROCEDURE cursor (x, y : INTEGER);
  23.  
  24. VAR regs : regs8088_ ;
  25.  
  26. BEGIN
  27.   regs.AH := $02;    regs.BH := 0;
  28.   regs.DH := y;      regs.DL := x;
  29.   INTR($10, regs);
  30. END;
  31.  
  32. (* ------------------------------------------------------ *)
  33. PROCEDURE Titel;
  34.  
  35. BEGIN
  36.   GotoXY(10, 1);   ClrEol;
  37.   WriteLn('LoadPic  (C) 1988 Dietmar Bueckart & PASCAL',
  38.           ' Int. ');
  39.   GotoXY(10, 3);   ClrEol;
  40.   WriteLn('Aktueller Pfad: ', pfad);
  41.   GotoXY(10, 4);   ClrEol;
  42.   WriteLn('Indexdatei    : ',lindex);
  43. END;
  44.  
  45. (* ------------------------------------------------------ *)
  46. PROCEDURE getpfad;
  47.  
  48. BEGIN
  49.   GotoXY(10, 3);   ClrEol;  pfad := '';
  50.   Write('Pfad im Format < Ziel-Laufwerk:\Directory\ >',
  51.         ' eingeben');
  52.   GotoXY(10, 4);   ClrEol;
  53.   Write('Neuer Pfad: ');    ReadLn(pfad);
  54. END;
  55.  
  56. (* ------------------------------------------------------ *)
  57. PROCEDURE getnamen (VAR picname : name);
  58.  
  59. VAR fertig : BOOLEAN;
  60.  
  61. BEGIN
  62.   ClrScr;   picname := '';
  63.   GotoXY(10, 10);  Write('Namen der Bilddatei eingeben: ');
  64.   GotoXY(10, 12);
  65.   REPEAT
  66.     Read(Kbd, ch);
  67.     IF ch <> #13 THEN BEGIN
  68.       ch := UpCase(ch); Write(ch);
  69.       picname := picname + ch; END
  70.     ELSE fertig := TRUE;
  71.   UNTIL fertig;
  72. END;
  73.  
  74. (* ------------------------------------------------------ *)
  75. PROCEDURE hercPrint;
  76.  
  77. VAR x, y : INTEGER;
  78.  
  79. BEGIN
  80.   Write(Lst, #27#65#7 );
  81.   FOR  x := 0 TO 89 DO BEGIN
  82.     Write(Lst, #27#75#92#1 );
  83.     FOR y := 347 DOWNTO 0 DO
  84.       Write(Lst, Chr(screen^[ByteOffset(x*8, y)] ) );
  85.     WriteLn(Lst);
  86.   END;
  87.   Write(Lst, #13#10#12#27#50);
  88. END;
  89.  
  90. (* ------------------------------------------------------ *)
  91. PROCEDURE CgaPrint;
  92.  
  93. VAR regs : regs8088_ ;
  94.  
  95. BEGIN
  96.   INTR($5, regs);   Write(Lst, #13#10#12#27#50);
  97. END;
  98.  
  99. (* ------------------------------------------------------ *)
  100. PROCEDURE hardcopy(ext : extension);
  101.  
  102. BEGIN
  103.   IF ext = 'CGA' THEN CgaPrint;
  104.   IF (ext = 'HGG') OR (ext = 'HGC')  THEN hercPrint;
  105. END;
  106.  
  107. (* ------------------------------------------------------ *)
  108. PROCEDURE displayPic (TEXT : name);
  109.  
  110. VAR index   : INTEGER;
  111.     picname : name;
  112.     picext  : extension;
  113.     dum     : TEXT;
  114.  
  115. BEGIN
  116.   lmodus := get_modus(lseite);
  117.   picname := '';  picext := '';
  118.   Delete (TEXT, 13, 80);   picname := TEXT;
  119.   index   := Pos('.', TEXT);
  120.   Delete(TEXT, 1, index);  picext  := TEXT;
  121.   picname := pfad + picname;
  122.   Assign(dum, picname);
  123.   {$I-}    ReSet(dum);    {$I+}
  124.   IF IOResult <> 0 THEN Exit;
  125.   IF picext = 'CGA' THEN cgaload(picname);
  126.   IF picext = 'EGA' THEN egaload(picname);
  127.   IF picext = 'HGC' THEN BEGIN
  128.     set_modus(7);
  129.     hercload(picname);
  130.   END;
  131.   IF picext = 'HGG' THEN BEGIN
  132.     set_modus(7);  GraphMode;
  133.     hercload(picname);
  134.   END;
  135.   cursor(0, 48);
  136.   Read(Kbd, ch);
  137.   IF ch = #27 THEN hardcopy(picext);
  138.   IF picext = 'HGG' THEN TextMode;
  139.   set_modus(lmodus);
  140. END;
  141.  
  142. (* ------------------------------------------------------ *)
  143. PROCEDURE getindex;
  144.  
  145. VAR I, J, Imax : INTEGER;
  146.  
  147. BEGIN
  148.   GotoXY(10, 4);    ClrEol;
  149.   Write('Indexdatei: ');   ReadLn(lindex);
  150.   IF Pos('.', lindex) = 0 THEN lindex := lindex + '.IDX';
  151.   lindex := pfad + lindex;  Titel;
  152.   Assign(Tdatei, lindex);
  153.   {$I-}     ReSet(Tdatei);     {$I+}
  154.   IF IOResult <> 0 THEN BEGIN
  155.     lindex := '';
  156.     Exit;
  157.   END;
  158.   I := -1;
  159.   WHILE NOT Eof(Tdatei) DO BEGIN
  160.     I := Succ(I);
  161.     ReadLn(Tdatei, picindex[I]);
  162.   END;
  163.   Imax := I;   J := 0;
  164.   WINDOW(1, 7, 80, 25);  ClrScr;  WINDOW(1, 1, 80, 25);
  165.   REPEAT
  166.     FOR I := 1 TO Imax DO BEGIN
  167.       GotoXY(4, 7+J);   WriteLn(I : 2, ':   ', picindex[I]);
  168.       J := Succ(J);
  169.       IF (J = Imax) OR (J = 16) THEN BEGIN
  170.         GotoXY(4, 25);
  171.         Write('weiter: <RETURN>    Ende: <E>   ',
  172.               ' Datei: <D>');
  173.         Read(Kbd, ch);   ch := UpCase(ch);
  174.         IF ch = 'E' THEN Exit ELSE IF ch = 'D' THEN BEGIN
  175.           GotoXY(37, 25);        ClrEol;
  176.           Write('Nummer: ');     ReadLn(J);
  177.           lname := picindex[J];  displayPic(lname);
  178.         END;
  179.         J := 0;
  180.         ClrScr;   Titel;
  181.       END;
  182.     END;
  183.   UNTIL ch = 'E';
  184. END;
  185.  
  186. (* ------------------------------------------------------ *)
  187. FUNCTION menue : CHAR;
  188.  
  189. BEGIN
  190.   ClrScr;  Titel;
  191.   GotoXY(10,  7);   WriteLn('< P >  neuen Pfad definieren');
  192.   GotoXY(10,  9);
  193.   WriteLn('< I >  neue Indexdatei definieren');
  194.   GotoXY(10, 11);
  195.   WriteLn('< D >  Dateinamen frei eingeben');
  196.   GotoXY(10, 13);   WriteLn('< Q >  LoadPic verlassen');
  197.   GotoXY(10, 15);   Write('Ihre Wahl ?  ');
  198.   REPEAT
  199.     Read(Kbd, ch);  ch := UpCase(ch);
  200.   UNTIL ch IN ['P', 'I', 'D', 'Q'];
  201.   menue := ch;
  202. END;
  203.  
  204. (* ------------------------------------------------------ *)
  205.  
  206. BEGIN
  207.   ClrScr;   ConOut := ConOutPtr;
  208.   pfad := '';   lindex := '';
  209.   REPEAT
  210.     ch := menue;
  211.     CASE ch OF
  212.       'P' : getpfad;
  213.       'D' : BEGIN
  214.               getnamen(lname);  displayPic(lname);
  215.             END;
  216.       'I' : getindex;
  217.     END;
  218.   UNTIL ch = 'Q';
  219. END.
  220.  
  221. (* ------------------------------------------------------ *)
  222. (*               Ende von LOADPIC.PAS                     *)
  223.