home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / VIDEOTEXT.LZX / VTsrc / dbluse.p < prev    next >
Encoding:
Text File  |  1996-04-19  |  14.3 KB  |  470 lines
  1. { Prozeduren, die in VT und VTview in identischer Frorm benötigt werden, }
  2. { gemeinsame Benutzung der entsprechenden Units wäre aber unökonomisch }
  3.  
  4. {$if def unit_sys }
  5.  
  6. PROCEDURE desaster{(meldung: Str80)};
  7. { erzeugt einen Alert }
  8. VAR egal: Boolean;
  9.     buf: Str80;
  10.     xpos: Integer;
  11. BEGIN
  12.   xpos := 320 - 4*Length(meldung);
  13.   buf := '   '+meldung;
  14.   buf[1] := Chr(Hi(xpos)); buf[2] := Chr(Lo(xpos));
  15.   buf[3] := Chr(18);
  16.   buf [Length(meldung)+5] := Chr(0);
  17.   egal := DisplayAlert(RECOVERY_ALERT,buf,32);
  18. END;
  19.  
  20. PROCEDURE stretch_line{(zeile, sp0, sp1: Integer)};
  21. { Streckt eine Textzeile am Bildschirm von sp0 bis einschließlich sp1 auf }
  22. { doppelte Höhe. }
  23. { Zeilen und Spalten werden, wie bei GotoXY üblich, ab 1 gezählt! }
  24. VAR charx,chary,i,y0,x0,breite: Integer;
  25. BEGIN
  26.   charx := MyWindow^.RPort^.TxWidth;
  27.   chary := MyWindow^.RPort^.TxHeight;
  28.   x0 := (sp0-1)*charx; breite := (sp1-sp0+1)*charx;
  29.   y0 := (zeile-1)*chary;
  30.   FOR i := chary-1 DOWNTO 0 DO BEGIN
  31.     ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i,breite,1,$C0);
  32.     ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i+1,breite,1,$C0);
  33.   END;
  34. END;
  35.  
  36. PROCEDURE raster_line{(zeile, sp0, sp1: Integer; farbe: Word)};
  37. { Grafikzeichen einer Zeile in seperate Rasterpunkte zerlegen, dazu dient }
  38. { Zeichen #159 des videotext.font }
  39. VAR charx,chary,baseline,y0,x0,i,anz: Integer;
  40.     dummy: str80;
  41.     egal: Long;
  42. BEGIN
  43.   charx := MyWindow^.RPort^.TxWidth;
  44.   chary := MyWindow^.RPort^.TxHeight;
  45.   baseline := MyWindow^.RPort^.TxBaseline;
  46.   x0 := (sp0-1)*charx; y0 := (zeile-1)*chary + baseline;
  47.   anz := sp1-sp0+1;
  48.   FOR i := 1 TO anz DO dummy[i] := #159;
  49.   SetAPen(MyWindow^.RPort,farbe); SetDrMd(MyWindow^.RPort,JAM1);
  50.   Move(MyWindow^.RPort,x0,y0); egal := _Text(MyWindow^.RPort,dummy,anz);
  51. END;
  52.  
  53. { *** ein paar Hilfsroutinen für die Menüerstellung: }
  54.  
  55. PROCEDURE AddMenu (dx: Integer; name: Str);
  56. VAR m: p_Menu;
  57.     it: IntuiText;
  58.     x: Integer;
  59. BEGIN
  60.   x := dx;
  61.   IF LastMenu<>Nil THEN x := x + LastMenu^.LeftEdge + LastMenu^.Width;
  62.   it := IntuiText(0, 1, JAM1, 0, 0, MyWindow^.WScreen^.Font, name, Nil);
  63.   New (m);
  64.   m^ := Menu(Nil, x, 0, IntuiTextLength(^it) + 8,
  65.                MyWindow^.WScreen^.Font^.ta_YSize, MENUENABLED,
  66.                name, Nil, 0, 0, 0, 0);
  67.   IF LastMenu=Nil THEN Strip := m
  68.     ELSE LastMenu^.NextMenu := m;
  69.   LastMenu := m; LastItem := Nil;
  70. END;
  71.  
  72. PROCEDURE AddItem (dy: Integer;  Flag: Word;  name: Str;  Com: Char);
  73. VAR i: p_MenuItem;
  74.     t: p_IntuiText;
  75.     w,y: Integer;
  76. BEGIN
  77.   IF LastMenu=Nil THEN Error('MenItem without Menu!');
  78.   y := dy;
  79.   IF LastItem<>Nil THEN y := y + LastItem^.TopEdge + LastItem^.Height;
  80.   New(i); New(t);
  81.   IF com>' ' THEN Flag := Flag OR COMMSEQ;
  82.   t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  83.   w := IntuiTextLength(t);
  84.   i^ := MenuItem(Nil, 0,y, w + 4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
  85.                  Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
  86.                  0, t, Nil, Com, Nil, 0);
  87.   IF LastItem=Nil THEN LastMenu^.FirstItem := i
  88.     ELSE LastItem^.NextItem := i;
  89.   LastItem := i; LastSubItem := Nil;
  90. END;
  91.  
  92. PROCEDURE AddSubItem (dy: Integer; Flag: Word; name: Str;  Com: Char);
  93. VAR s: p_MenuItem;
  94.     t: p_IntuiText;
  95.     w,y: Integer;
  96. BEGIN
  97.   IF LastItem=Nil THEN Error('SubItem without MenItem');
  98.   y := dy;
  99.   IF LastSubItem<>Nil THEN y := y + LastSubItem^.TopEdge + LastSubItem^.Height;
  100.   New(s); New(t);
  101.   If com>' ' THEN Flag := Flag OR COMMSEQ;
  102.   t^ := IntuiText(0,1, JAM1, 2,1, MyWindow^.WScreen^.Font, name, Nil);
  103.   w := IntuiTextLength(t);
  104.   s^ := MenuItem(Nil, LastItem^.Width-12, y, w+4,MyWindow^.WScreen^.Font^.ta_YSize + 2,
  105.                    Flag OR ITEMTEXT OR ITEMENABLED OR HIGHCOMP,
  106.                    0, t, Nil, Com, Nil, 0);
  107.   IF LastSubItem=Nil THEN LastItem^.SubItem := s
  108.     ELSE LastSubItem^.NextItem := s;
  109.   LastSubItem := s;
  110. END;
  111.  
  112. PROCEDURE MutEx(exc: LongInt);
  113. VAR i: p_MenuItem;
  114. BEGIN
  115.   i := LastItem;
  116.   IF i=Nil THEN Error('no Item for MutEx');
  117.   IF LastSubItem<>Nil THEN i := LastSubItem;
  118.   i^.MutualExclude := exc;
  119.   i^.Flags := i^.Flags AND NOT MENUTOGGLE;
  120. END;
  121.  
  122. PROCEDURE ItEnable(really: Boolean);
  123. VAR i: p_MenuItem;
  124. BEGIN
  125.   i := LastItem;
  126.   IF i=Nil THEN Error('no Item for ItEnable');
  127.   IF LastSubItem<>Nil THEN i := LastSubItem;
  128.   IF NOT really THEN
  129.     i^.Flags := i^.Flags AND NOT ITEMENABLED;
  130. END;
  131.  
  132. PROCEDURE CalcMenuWidth(f: p_MenuItem);
  133. { alle Einträge einer Menüspalte auf gleiche Breite bringen }
  134. VAR i: p_MenuItem;
  135.     t: p_IntuiText;
  136.     max, w: Integer;
  137. BEGIN
  138.   i := f;
  139.   max := 8;
  140.   WHILE i<>Nil DO BEGIN
  141.     t := i^.ItemFill;
  142.     w := 2 + IntuiTextLength(t) + t^.LeftEdge;
  143.     IF i^.Flags AND COMMSEQ<>0 THEN w := w + 48;
  144.     IF w>max THEN max := w;
  145.     i := i^.NextItem;
  146.   END;
  147.   i := f;
  148.   WHILE i<>Nil DO BEGIN
  149.     i^.Width := max
  150.     i := i^.NextItem
  151.   END;
  152. END;
  153.  
  154. PROCEDURE MenuWidths;
  155. { CalcMenuWidth auf alle Menüs und Untermenüs anwenden }
  156. VAR m: p_Menu;
  157.     i: p_MenuItem;
  158. BEGIN
  159.   m := Strip;
  160.   WHILE m<>Nil DO BEGIN
  161.     i := m^.FirstItem;
  162.     IF i<>Nil THEN CalcMenuWidth(i);
  163.     WHILE i<>Nil DO BEGIN
  164.       IF i^.SubItem<>Nil THEN
  165.         CalcMenuWidth(i^.SubItem);
  166.       i := i^.NextItem;
  167.     END;
  168.     m := m^.NextMenu;
  169.   END;
  170. END;
  171.  
  172. PROCEDURE TrashMenu;
  173. { die aufgebaute Menü-Struktur wegwerfen }
  174. VAR m, m2: p_Menu;
  175.     i, i2: p_MenuItem;
  176.     t:     p_IntuiText;
  177. BEGIN
  178.   m := Strip;
  179.   WHILE m<>Nil DO BEGIN
  180.     i := m^.FirstItem;
  181.     WHILE i<>Nil DO BEGIN
  182.       i2 := i;
  183.       t := i^.ItemFill;
  184.       i := i^.NextItem;
  185.       Dispose(t);
  186.       Dispose(i2)
  187.     END;
  188.     m2 := m;
  189.     m := m^.NextMenu;
  190.     Dispose(m2)
  191.   END;
  192.   LastMenu := Nil; Strip := Nil;
  193. END;
  194.  
  195. {$endif }
  196.  
  197. {$if def unit_bildschirm }
  198.  
  199. PROCEDURE writepage{(seite: p_onepage, verdeckt: Boolean)};
  200. { Seite am Bildschirm ausgeben }
  201. VAR zeile,limit,i,j,j0: Integer;
  202.     farbe,farbe0: Word;
  203.     out: bigstring;
  204.     x: Byte;
  205.     s,attrib: str80;
  206.     dblheight,rastergfx,special: Boolean;
  207.     normal: String[10];
  208. BEGIN
  209.   incomplete := True;
  210.   limit := 24;
  211.   visblpage := seite;
  212.   concealed := verdeckt;
  213.   normal := #155'0;3'+colperms[7]+';4'+colperms[0]+'m'; { weiß auf schwarz }
  214.   dblheight := False; rastergfx := False;
  215.   IF seite<>Nil THEN BEGIN
  216.     IF seite^.pg>0 THEN seite^.chars[0] := 2  { Seitennummer zunächst grün }
  217.     { Seiten "ohne" Seitennummer dürfen sich wünschen, wieviele Zeilen von }
  218.     { ihnen ausgegeben werden sollen: }
  219.     ELSE IF seite^.sp IN [1..24] THEN limit := seite^.sp-1;
  220.   END;
  221.   FOR i := 0 TO limit DO BEGIN
  222.     zeile := i MOD 24;
  223.     IF i=24 THEN BEGIN
  224.       { 1. Zeile nochmal, mit weißer Seitennummer: }
  225.       IF seite<>Nil THEN IF seite^.pg>0 THEN
  226.         seite^.chars[0] := 7;
  227.       dblheight := False;
  228.     END;
  229.     IF dblheight THEN
  230.       { auf eine doppelthohe Zeile folgt nur eine leere Zeile }
  231.       dblheight := False
  232.     ELSE BEGIN
  233.       { normale Zeile ausgeben }
  234.       IF seite<>Nil THEN
  235.         decode_line(seite, zeile, verdeckt, out, attrib, dblheight, rastergfx)
  236.       ELSE
  237.         out := blank40;
  238.       GotoXY(pgoffx,zeile+1); Write(normal,out,normal,' ');
  239.       IF rastergfx THEN BEGIN  { Zeile, die gerasterte Grafikzeichen enthält }
  240.         special := False; farbe := 0;
  241.         FOR j := 0 TO 39 DO BEGIN  { zu rasternde Abschnitte suchen }
  242.           farbe0 := farbe; farbe := Ord(attrib[j+1]);
  243.           IF (farbe<>farbe0) AND special THEN BEGIN
  244.             raster_line(zeile+1,pgoffx+j0,pgoffx+j-1,farbe0 AND 7);
  245.             j0 := j; special := (farbe AND 16<>0);
  246.           END;
  247.           IF (farbe AND 16<>0) AND NOT special THEN BEGIN
  248.             j0 := j; special := True;
  249.           END;
  250.         END;
  251.         IF special THEN
  252.           raster_line(zeile+1,pgoffx+j0,pgoffx+39,farbe0 AND 7);
  253.       END;
  254.       IF zeile=23 THEN dblheight := False; { unterste Zeile nie doppelthoch! }
  255.       IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
  256.         special := False;
  257.         FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
  258.           { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
  259.           IF out[j] = #155 THEN special := True;
  260.           IF NOT special THEN out[j] := ' ';
  261.           IF out[j] = 'm' THEN special := False;
  262.         END;
  263.         GotoXY(pgoffx,zeile+2); Write(normal,out,normal,' ');
  264.         special := False;
  265.         FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
  266.           CASE seite^.chars[40*zeile+j] OF
  267.             13: BEGIN j0 := j; special := True; END;
  268.             12: IF special THEN BEGIN
  269.                 stretch_line(zeile+1,pgoffx+j0,pgoffx+j); special := False;
  270.               END;
  271.             OTHERWISE;
  272.           END;
  273.         IF special THEN
  274.           stretch_line(zeile+1,pgoffx+j0,79);
  275.       END;
  276.     END;
  277.     event_scan; IF newevent THEN  Exit;
  278.   END;
  279.   incomplete := False;   { Seite komplett }
  280. END;
  281.  
  282. FUNCTION number_from_page{(x,y: Integer): Integer};
  283. { versucht zu einer angeklickten Bildschirmposition herauszufinden, auf }
  284. { was für eine Nummer geklickt wurde }
  285. VAR i,j,j0,n,m: Integer;
  286.     ok,special,hidden: Boolean;
  287. BEGIN
  288.   n := -1;
  289.   IF (x IN [pgoffx..pgoffx+39]) AND (y IN [1..24]) AND (visblpage<>Nil) THEN BEGIN
  290.     i := 40*(y-1); { 1. Zeichen der Zeile }
  291.     { Sonderfall: untere Hälfte einer doppelthohen Zeile? }
  292.     special := False;
  293.     IF y>1 THEN
  294.       FOR j := -40 TO -1 DO
  295.         IF visblpage^.chars[i+j]=13 THEN special := True;
  296.     IF special THEN i := i-40;  { eine Zeile höher gehen }
  297.     { versuchen eine Zahl zu lesen, die (x,y) enthält }
  298.     ok := True; j0 := x-pgoffx;
  299.     FOR j := x-pgoffx DOWNTO 0 DO BEGIN
  300.       IF NOT (visblpage^.chars[i+j] IN [48..57]) THEN ok := False;
  301.       IF ok THEN j0 := j;
  302.     END;
  303.     ok := True; n := 0; m := 0;
  304.     FOR j := j0 TO 39 DO BEGIN
  305.       IF NOT (visblpage^.chars[i+j] IN [48..57]) THEN ok := False;
  306.       IF ok THEN BEGIN
  307.         n := (n SHL 4) + visblpage^.chars[i+j]-48; Inc(m);
  308.       END;
  309.     END;
  310.     IF m=0 THEN n := -1;  { keine Ziffern gefunden }
  311.     { die gefundene Zahl ist aber möglicherweise gar nicht sichtbar! }
  312.     special := False; hidden := False;
  313.     FOR j := 0 TO j0 DO
  314.       IF visblpage^.chars[i+j]<32 THEN BEGIN
  315.         hidden := False;
  316.         CASE visblpage^.chars[i+j] OF
  317.           0..7: special := False;
  318.           16..23: special := True;
  319.           24: hidden := True;
  320.           OTHERWISE;
  321.         END;
  322.       END;
  323.     IF special OR (hidden AND concealed) THEN n := -1;
  324.   END;
  325.   number_from_page := n;
  326. END;
  327.  
  328. {$endif }
  329.  
  330. {$if def unit_datei }
  331.  
  332. FUNCTION getlong(VAR datei: Text): Long;
  333. VAR l: Long;
  334.     i: Integer;
  335.     ch: Char;
  336. BEGIN
  337.   l := 0;
  338.   FOR i := 1 TO 4 DO BEGIN
  339.     Read(datei,ch);
  340.     l := (l SHL 8) OR Ord(ch);
  341.   END;
  342.   getlong := l;
  343. END;
  344.  
  345. FUNCTION filetype{(name: Str80): Integer};
  346. { Typcodierung: }
  347. { -1: Datei existiert nicht (oder ist leer) }
  348. {  0: unbekannter Typ (vermutlich roher ASCII-Text) }
  349. {  1: programmeigener Typ 'VTPG'=$56545047 }
  350. {     VTex-Format 'FG24'=$46473234 }
  351. {     oder TeleText 'TELE'=$54454C45 }
  352. {  2: AmigaDOS-Programmdatei $000003F3 }
  353. {  3: IFF-Datei 'FORM'=$464F524D }
  354. {  4: Workbench-Icon $E310 }
  355. VAR head: Long;
  356.     datei: Text;
  357. BEGIN
  358.   Reset(datei,name);
  359.   IF IOresult=0 THEN BEGIN
  360.     filetype := 0;
  361.     head := getlong(datei);
  362.     IF EoF(datei) THEN filetype := -1; { leere Datei }
  363.     IF head=$56545047 THEN filetype := 1;
  364.     IF head=$46473234 THEN filetype := 1;
  365.     IF head=$54454C45 THEN filetype := 1;
  366.     IF head=$000003F3 THEN filetype := 2;
  367.     IF head=$464F524D THEN filetype := 3;
  368.     IF (head SHR 16)=$E310 THEN filetype := 4;
  369.     Close(datei);
  370.   END ELSE
  371.     filetype := -1; { Datei existiert nicht }
  372. END;
  373.  
  374. FUNCTION getpages{(filename: Str80; sorted: Boolean): Integer};
  375. { Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
  376. { einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
  377. VAR i,j, jlpageno, gelesen: Integer;
  378.     bytes: ^ARRAY[1..41] OF Char;
  379.     datei: Text;
  380.     zeile: Str80;
  381.     seite: p_onepage;
  382.     l: Long;
  383.     c: Char;
  384. CONST vtpg=$56545047;
  385.       fg24=$46473234;
  386.       tvtx=$54565458;
  387.       tele=$54454C45;
  388.       texd=$54455854;
  389.        sub=$535542;
  390. PROCEDURE findword;
  391. { Hilft, zeile in Worte zu zerlegen. Parameter j: Startpunkt, Ergebnis: }
  392. { i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  393. BEGIN
  394.   i := j; WHILE (zeile[i]=' ') AND (zeile[i]<>#0) DO Inc(i);
  395.   j := i + 1; WHILE NOT (zeile[j] IN [' ',#0]) DO Inc(j);
  396. END;
  397. BEGIN
  398.   gelesen := 0;
  399.   Reset(datei,filename);
  400.   IF (IOresult<>0) THEN     { Datei existiert nicht }
  401.     Exit;
  402.   Buffer(datei,200);
  403.   WHILE NOT EoF(datei) DO BEGIN
  404.     l := 0;
  405.     REPEAT
  406.       Read(datei,c); l := l SHL 8 OR Ord(c);
  407.     UNTIL (l=vtpg) OR (l=fg24) OR (l=tele) OR (l AND $FFFFFF=sub)
  408.     OR EoF(datei);
  409.     { mein eigenes Format lesen: }
  410.     IF l=vtpg THEN BEGIN
  411.       New(seite);
  412.       Read(datei,c); { LF überlesen }
  413.       FOR i := 0 TO 23 DO BEGIN
  414.         bytes := Ptr(^seite^.chars[40*i]);
  415.         BlockRead(datei,bytes^,40);
  416.         Read(datei,c); { LF überlesen }
  417.       END;
  418.       ReadLn(datei,zeile); j := 1;
  419.       findword; seite^.pg := hexval(Copy(zeile,i,j-i));
  420.       findword; seite^.sp := hexval(Copy(zeile,i,j-i));
  421.       findword; seite^.cbits := hexval(Copy(zeile,i,j-i));
  422.       seite^.dejavu := False;
  423.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  424.       Inc(gelesen);
  425.     END;
  426.     { das Format der VTex-Software lesen: }
  427.     IF l=fg24 THEN IF getlong(datei)=tvtx THEN BEGIN
  428.       New(seite);
  429.       seite^.pg := make_bcd(getlong(datei));
  430.       seite^.sp := make_bcd(getlong(datei));
  431.       seite^.cbits := 0;
  432.       l := getlong(datei); { aus der Zeichensatz-Nummer die Steuerbits }
  433.       FOR i := 14 DOWNTO 12 DO BEGIN { C12,C13,C14 "rekonstruieren" }
  434.         IF Odd(l) THEN seite^.cbits := seite^.cbits OR (1 SHL i);
  435.         l := l SHR 1;
  436.       END;
  437.       FOR i := 1 TO 18 DO Read(datei,c); { ??? }
  438.       BlockRead(datei,seite^.chars,960);
  439.       seite^.dejavu := False;
  440.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  441.       Inc(gelesen);
  442.     END;
  443.     { Jan Leuverink's TeleText-Format lesen: }
  444.     IF l=tele THEN IF getlong(datei)=texd THEN BEGIN  { header }
  445.       jlpageno := 0;
  446.       FOR i := 1 TO 3 DO BEGIN
  447.         Read(datei,c); jlpageno := (jlpageno SHL 4) OR (Ord(c)-Ord('0'));
  448.       END;
  449.     END;
  450.     IF (l AND $FFFFFF=sub) THEN BEGIN  { eine Seite }
  451.       New(seite);
  452.       seite^.pg := jlpageno;
  453.       seite^.sp := 0;
  454.       seite^.cbits := $4000;  { immer dt. Zeichensatz %-( }
  455.       FOR i := 1 TO 4 DO BEGIN
  456.         Read(datei,c); IF c>='0' THEN
  457.           seite^.sp := (seite^.sp SHL 4) OR (Ord(c)-Ord('0'));
  458.       END;
  459.       BlockRead(datei,seite^.chars,960);
  460.       seite^.dejavu := False;
  461.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  462.       Inc(gelesen);
  463.     END;
  464.   END;
  465.   Close(datei);
  466.   getpages := gelesen;
  467. END;
  468.  
  469. {$endif }
  470.