home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / VIDEOTEXT.LZX / VTsrc / info.p < prev    next >
Encoding:
Text File  |  1996-02-26  |  13.6 KB  |  387 lines
  1. UNIT info; {$project vt }
  2. { Generierung von Sonderseiten zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES jobs;
  5.  
  6. PROCEDURE topinfo(top0,top1: p_onepage);
  7. PROCEDURE kill_topmenu;
  8. PROCEDURE create_topmenu(pg0,pg2,pg3,pg4: p_onepage);
  9. PROCEDURE say_hello(version: Str80);
  10. PROCEDURE helpme;
  11. PROCEDURE guru(nr: Byte);
  12.  
  13. { ---------------------------------------------------------------------- }
  14.  
  15. IMPLEMENTATION;
  16.  
  17. {$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
  18.  
  19. { eine VT-Seite, die nicht in der Liste verwaltet werden muß: }
  20. VAR infopage: onepage; STATIC; 
  21.  
  22. PROCEDURE write_to_page(x,y: Integer; txt: Str80; vgf,hgf: Integer;
  23.                        seite: p_onepage);
  24. { Text in eine Videotextseite schreiben. }
  25. { x und y werden ab 0 gezählt. Umlaute werden konvertiert. Wenn vgf oder }
  26. { hgf -1 sind, werden keine Farbsteuerzeichen erzeugt -> Platzersparnis. }
  27. VAR i,j: Integer;
  28. BEGIN
  29.   IF y>23 THEN Exit;
  30.   i := x + 40*y;
  31.   IF hgf=0 THEN BEGIN
  32.     seite^.chars[i] := 28; Inc(i);
  33.   END;
  34.   IF hgf>0 THEN BEGIN
  35.     seite^.chars[i] := hgf; Inc(i);
  36.     seite^.chars[i] := 29; Inc(i);
  37.   END;
  38.   IF vgf>=0 THEN BEGIN
  39.     seite^.chars[i] := vgf; Inc(i);
  40.   END;
  41.   FOR j := 1 TO Length(txt) DO BEGIN
  42.     CASE txt[j] OF
  43.       'ä': seite^.chars[i] := Ord('{');
  44.       'ö': seite^.chars[i] := Ord('|');
  45.       'ü': seite^.chars[i] := Ord('}');
  46.       'ß': seite^.chars[i] := Ord('~');
  47.       'Ä': seite^.chars[i] := Ord('[');
  48.       'Ö': seite^.chars[i] := Ord('\');
  49.       'Ü': seite^.chars[i] := Ord(']');
  50.       OTHERWISE seite^.chars[i] := Ord(txt[j]);
  51.     END;
  52.     IF i<959 THEN Inc(i);
  53.   END;
  54. END;
  55.  
  56. PROCEDURE char_to_page(x,y: Integer; c: Char; seite: p_onepage);
  57. BEGIN
  58.   IF (y IN [0..23]) AND (x IN [0..39]) THEN 
  59.     seite^.chars[x+40*y] := Ord(c);
  60. END;
  61.  
  62. PROCEDURE init_page(seite: p_onepage);
  63. { gerade mit New() erzeugte Seite zum Selbstbeschreiben vorbereiten. }
  64. { Nur pg und sp müssen bereits eingetragen sein. }
  65. VAR i: Integer;
  66.     s: Str80;
  67. BEGIN
  68.   seite^.dejavu := False; { als Neuheit kennzeichnen }
  69.   FOR i := 0 TO 959 DO seite^.chars[i] := 32;
  70.   seite^.cbits := $4A00; { wichtig: deutscher Zeichensatz! }
  71.   IF seite^.pg>0 THEN BEGIN
  72.     s := '('+hexstr(seite^.sp,4)+') '+hexstr(seite^.pg,3);
  73.     write_to_page(0,0,s,7,-1,seite);
  74.     write_to_page(16,0,'lokal erzeugte VT-Seite',5,-1,seite);
  75.   END;
  76. END;
  77.  
  78. PROCEDURE topinfo{(top0,top1: p_onepage)};
  79. { wertet die TOPtext-Seiten 1F0 und 1F1 aus, erzeugt zwei Seiten Information }
  80. { bzw., sofern schon vorhanden, aktualisiert diese nur. }
  81. VAR i,j,k,n: Integer;
  82.     npg,nsp,nlrg: Integer;
  83.     pg1,pg2: p_onepage;
  84.     s: Str80;
  85. BEGIN
  86.   pg1 := hunt_in_list($999,1,True);
  87.   pg2 := hunt_in_list($999,2,True);
  88.   IF pg1=Nil THEN BEGIN
  89.     New(pg1); pg1^.pg := $999; pg1^.sp := 1;
  90.     ins_to_list(pg1); update_list(pg1,1);
  91.   END;
  92.   IF pg2=Nil THEN BEGIN
  93.     New(pg2); pg2^.pg := $999; pg2^.sp := 2;
  94.     ins_to_list(pg2); update_list(pg2,1);
  95.   END;
  96.   init_page(pg1);
  97.   init_page(pg2);
  98.   npg := 0; nsp := 0; nlrg := 0;
  99.   write_to_page(0,1,'Seitenbelegung (laut TOP-Text)  1/2',3,4,pg1);
  100.   write_to_page(0,1,'Seitenbelegung (laut TOP-Text)  2/2',3,4,pg2);
  101.   FOR i := 10 TO 89 DO BEGIN
  102.     s := IntStr(10*i)+': ----------';
  103.     j := 10*i-60;
  104.     FOR k := 0 TO 9 DO
  105.       IF NOT (topcode[top0^.chars[j+k]] IN [0,16]) THEN BEGIN
  106.         Inc(npg); n := topcode[top1^.chars[j+k]]
  107.         CASE n OF
  108.           0: BEGIN s[k+6] := #127; Inc(nsp); END;
  109.           1..9: BEGIN s[k+6] := Chr(48+n); nsp := nsp + n; END;
  110.           10: BEGIN s[k+6] := '+'; Inc(nlrg); nsp := nsp + n; END;
  111.           OTHERWISE s[k+6] := '?'; Dec(npg); { :-( }
  112.         END;
  113.       END ELSE IF topcode[top0^.chars[j+k]]=16 THEN
  114.         s[k+6] := '?';
  115.     IF Odd(i DIV 10) THEN j := 2 ELSE j := 21;
  116.     IF Odd((i+10) DIV 20) THEN k := i MOD 10+2 ELSE k := i MOD 10+13;
  117.     IF i<50 THEN BEGIN
  118.       write_to_page(j,k,s,7,-1,pg1); char_to_page(j+5,k,#6,pg1);
  119.     END ELSE BEGIN
  120.       write_to_page(j,k,s,7,-1,pg2); char_to_page(j+5,k,#6,pg2);
  121.     END;
  122.   END;
  123.   s := IntStr(npg)+' Seitennummern';
  124.   write_to_page(0,12,s,7,5,pg1);
  125.   s := ''; IF nlrg>0 THEN
  126.     s := IntStr(nlrg)+' mit "mehr als 9" Unterseiten';
  127.   write_to_page(0,23,s,3,1,pg1);
  128.   s := IntStr(nsp)+' kByte Text';
  129.   IF nlrg>0 THEN s := 'mind. ' + s;
  130.   write_to_page(0,12,s,7,5,pg2);
  131.   j := 0;
  132.   FOR i := 100 TO 899 DO
  133.     IF topcode[top0^.chars[i-60]]=1 THEN j := i;
  134.   s := 'zur Zeit keine Untertitel';
  135.   IF j>0 THEN s := 'VT-Untertitel auf Seite '+IntStr(j);
  136.   write_to_page(0,23,s,3,1,pg2);
  137. END;
  138.  
  139. PROCEDURE kill_topmenu;
  140. { den ganzen Müll von create_topmenu aus der Seitenliste entfernen }
  141. VAR seite,hilf: p_onepage;
  142. BEGIN
  143.   seite := root;
  144.   WHILE seite<>Nil DO BEGIN
  145.     hilf := seite; seite := seite^.next;
  146.     IF hilf^.pg>=$900 THEN del_from_list(hilf);
  147.   END;
  148. END;
  149.  
  150. PROCEDURE create_topmenu{(pg0,pg2,pg3,pg4: p_onepage)};
  151. { benutzt die TOPtext-Seiten 1F0, 1F2 [1F3 [1F4]], um ein Menü aus Seiten }
  152. { mit Schlagwörtern und anklickbaren Seitennummern zu erzeugen }
  153. VAR i,j,k,l,n,gap,npg,nttl,nblk: Integer;
  154.     boff,goff: Integer;
  155.     titel: ARRAY[0..3*2*23] OF RECORD
  156.       name: String[13];
  157.       nr: Integer;
  158.       typ: Byte;
  159.     END; STATIC;
  160.     block: ARRAY[1..23] OF RECORD
  161.       adr,abh,menue: Integer;
  162.     END; STATIC;
  163.     pg: ARRAY[2..4] OF p_onepage;
  164.     newpg: p_onepage;
  165.     s: str80;
  166.     ch: Char;
  167. BEGIN
  168.   kill_topmenu; { die alten 900er Seiten entfernen }
  169.   pg[2] := pg2; pg[3] := pg3; pg[4] := pg4;
  170.   npg := 0; FOR i := 2 TO 4 DO IF pg[i]<>Nil THEN Inc(npg);
  171.   FOR i := 1 TO 23 DO
  172.     FOR j := 1 TO 2*npg DO WITH titel[23*(j-1)+i] DO BEGIN
  173.       gettopnum(pg[1+(j+1) DIV 2],20*(1-j MOD 2),i,nr,k);
  174.       IF (nr<0) OR (k<0) OR (nr>$899) THEN
  175.         nr := $900; { ungültige Codierung! }
  176.       IF nr<$100 THEN nr := nr + $800;
  177.       nr := get_bcd(nr);
  178.       IF nr<900 THEN
  179.         typ := topcode[pg0^.chars[nr-60]]
  180.       ELSE
  181.         typ := 0;
  182.       name[13] := #0;
  183.       FOR k := 1 TO 12 DO BEGIN
  184.         name[k] := Chr(pg[1+(j+1) DIV 2]^.chars[40*i+20*(1-j MOD 2)+7+k]);
  185.         IF name[k]<' ' THEN name[k] := ' ';
  186.       END;
  187.     END;
  188.   nttl := 2*23*npg;
  189.   { nach Nummern sortieren (Shell-Sort): }
  190.   gap := nttl DIV 2;
  191.   WHILE gap>0 DO BEGIN
  192.     FOR i := gap+1 TO nttl DO BEGIN
  193.       j := i-gap;
  194.       WHILE j>0 DO BEGIN
  195.         IF titel[j].nr>titel[j+gap].nr THEN BEGIN
  196.           titel[0] := titel[j];
  197.           titel[j] := titel[j+gap];
  198.           titel[j+gap] := titel[0];
  199.           j := j - gap;
  200.         END ELSE
  201.           j := 0;
  202.       END;
  203.     END;
  204.     gap := gap DIV 2;
  205.   END;
  206.   WHILE (titel[nttl].typ=0) AND (nttl>0) DO Dec(nttl);
  207.   { Feststellen, wieviele Blöcke es gibt, wieviele Gruppen- und normale }
  208.   { Seiten von ihnen abhängig sind, und ob sie eine eigene Menüseite }
  209.   { verdienen: }
  210.   nblk := 0; n := 900;
  211.   FOR i := 1 TO nttl DO
  212.     IF (titel[i].typ IN [1..5]) AND (nblk<23) THEN BEGIN
  213.       Inc(nblk);
  214.       block[nblk].adr := i; block[nblk].abh := 0; block[nblk].menue := n;
  215.       IF (titel[i].typ<>1) AND (i<nttl) THEN BEGIN
  216.         j := i;
  217.         REPEAT
  218.           Inc(j); IF titel[j].typ>5 THEN Inc(block[nblk].abh);
  219.         UNTIL (j=nttl) OR (titel[j].typ IN [2..5]);
  220.       END;
  221.       IF block[nblk].abh=0 THEN block[nblk].menue := 0 ELSE Inc(n);
  222.       IF block[nblk].abh>23 THEN block[nblk].abh := 23;
  223.     END;
  224.   IF n=900 THEN block[1].menue := n; { häh? kein Block hat Gruppenseiten? }
  225.   { Offset des Blockmenues in jeder Seite: }
  226.   boff := 1 + (23-nblk) DIV 2;
  227.   { Menüseiten aufbauen: }
  228.   FOR i := 1 TO nblk DO
  229.     IF block[i].menue>0 THEN BEGIN
  230.       New(newpg); newpg^.pg := make_bcd(block[i].menue); newpg^.sp := 0;
  231.       ins_to_list(newpg); init_page(newpg); 
  232.       { Offset des Gruppenmenues in dieser Seite: }
  233.       goff := boff+i-(1+block[i].abh) DIV 2;
  234.       IF goff+block[i].abh>24 THEN goff := 24-block[i].abh;
  235.       IF goff<1 THEN goff := 1;
  236.       { alle Blockseiten eintragen: }
  237.       j := boff;
  238.       FOR k := 1 TO nblk DO BEGIN
  239.         l := block[k].adr;
  240.         s := titel[l].name+' ';
  241.         IF k=i THEN BEGIN { dieser Block }
  242.           s := s+IntStr(titel[l].nr);
  243.           IF titel[l].typ IN [3,5] THEN s := s+'+';
  244.           write_to_page(0,j,s,0,6,newpg); { Schwarz auf Türkis }
  245.         END ELSE BEGIN { fremder Block }
  246.           s := s+IntStr(block[k].menue);
  247.           write_to_page(0,j,s,6,4,newpg) { Türkis auf Blau }
  248.           IF block[k].menue=0 THEN BEGIN { Block ohne eigene Seite }
  249.             write_to_page(15,j,IntStr(titel[l].nr),3,-1,newpg); { Gelb }
  250.             IF titel[l].typ IN [3,5] THEN char_to_page(19,j,'+',newpg);
  251.           END;
  252.           write_to_page(21,j,' ',-1,0,newpg); { schwarzer Hintergrund }
  253.         END;
  254.         Inc(j);
  255.       END;
  256.       { Gruppen- und normale Seiten dieses Blocks eintragen: }
  257.       j := goff; k := 0; l := block[i].adr;
  258.       WHILE (k<block[i].abh) AND (l<nttl) DO BEGIN
  259.         Inc(l);
  260.         IF titel[l].typ>5 THEN BEGIN
  261.           s := titel[l].name+' '+IntStr(titel[l].nr);
  262.           IF titel[l].typ IN [7,10,11] THEN s := s+'+';
  263.           IF titel[l].typ<8 THEN
  264.             write_to_page(20,j,s,0,3,newpg) { Schwarz auf Gelb }
  265.           ELSE
  266.             write_to_page(20,j,s,0,2,newpg) { Schwarz auf Grün }
  267.           Inc(k); Inc(j);
  268.         END;
  269.       END;
  270.     END;
  271. END;
  272.  
  273. PROCEDURE say_hello{(version: Str80)};
  274. VAR seite: p_onepage;
  275.     i: Integer;
  276. BEGIN
  277.   seite := ^infopage;
  278.   seite^.pg := $1; seite^.sp := $0;
  279.   init_page(seite);
  280.   i := 1;
  281.   write_to_page(0,i,#13,3,4,seite);
  282.   write_to_page(13,i,Copy(version,7,14),-1,-1,seite); Inc(i);
  283.   Inc(i);
  284.   write_to_page(0,i,'  Teletext-Software für den Amiga',4,6,seite); Inc(i);
  285.   Inc(i);
  286.   write_to_page(0,i,  '        benötigte Hardware:',7,5,seite); Inc(i);
  287.   write_to_page(0,i,'   I2C-Bus Interface und VT-Decoder',6,-1,seite); Inc(i);
  288.   write_to_page(0,i,'  z. B. das Projekt aus der c''t 7/92',6,-1,seite); Inc(i);
  289.   Inc(i);
  290.   write_to_page(0,i,  '     Programmautor (1992-96):',7,5,seite); Inc(i);
  291.   write_to_page(0,i,'            Wilhelm Nöker',6,-1,seite); Inc(i);
  292.   write_to_page(0,i,'    Hertastr. 8, D-44388 Dortmund',6,-1,seite); Inc(i);
  293.   Inc(i);
  294.   write_to_page(0,i,  '             Compiler:',7,5,seite); Inc(i);
  295.   write_to_page(0,i,'  KICK-Pascal 2.12 von MAXON Computer',6,-1,seite); Inc(i);
  296.   Inc(i);
  297.   write_to_page(0,i,  '           "i2c.library":',7,5,seite); Inc(i);
  298.   write_to_page(0,i,'       Copyright (c) Brian Ipsen',6,-1,seite); Inc(i);
  299.   Inc(i);
  300.   write_to_page(0,i,#13'            FREEWARE',3,4,seite); Inc(i);
  301.   Inc(i);
  302.   write_to_page(0,i,'   "Spread the word & the disk!"',4,6,seite); Inc(i);
  303.   write_to_page(0,i,'   (Spenden sind aber willkommen ;-)',6,-1,seite); Inc(i);
  304.   Inc(i);
  305.   writepage(seite,True);
  306. END;
  307.  
  308. PROCEDURE helpme;
  309. { Hilfstext ausgeben }
  310. VAR i,j: Integer;
  311.     seite: p_onepage;
  312. BEGIN
  313.   seite := ^infopage;
  314.   seite^.pg := $2; seite^.sp := $0;
  315.   init_page(seite);
  316.   i := 1;
  317.   write_to_page(0,i,#13'    VideoText - Kurzanleitung',3,1,seite); Inc(i);
  318.   Inc(i);
  319.   write_to_page(0,i,'          Seitenanforderung:',4,6,seite); Inc(i);
  320.   write_to_page(0,i,' Einfach dreistellige Seitennummern',7,-1,seite); Inc(i);
  321.   write_to_page(0,i,' eintippen, mit (Return) abschließen.',7,-1,seite); Inc(i);
  322.   write_to_page(0,i,' Korrektur möglich mit (<-).',7,-1,seite); Inc(i);
  323.   Inc(i);
  324.   write_to_page(0,i,'             Beispiele:',4,6,seite); Inc(i);
  325.   write_to_page(0,i,' Grundform (reicht meistens):   100',7,-1,seite); Inc(i);
  326.   write_to_page(0,i,' eine bestimmte Unterseite:     100/1',7,-1,seite); Inc(i);
  327.   write_to_page(0,i,' eine beliebige Unterseite:     100/*',7,-1,seite); Inc(i);
  328.   write_to_page(0,i,' selbstnumerierende Seiten:     100-7',7,-1,seite); Inc(i);
  329.   write_to_page(0,i,' Bildschirmüberwachung:         150/.',7,-1,seite); Inc(i);
  330.   write_to_page(0,i,' Dateiprotokoll:                150/!',7,-1,seite); Inc(i);
  331.   FOR j := i-6 TO i-1 DO char_to_page(30,j,#3,seite);
  332.   Inc(i);
  333.   write_to_page(0,i,'          Mausunterstützung:',4,6,seite); Inc(i);
  334.   write_to_page(0,i,' Fast alles auf dem Bildschirm',7,-1,seite); Inc(i);
  335.   write_to_page(0,i,' reagiert irgendwie auf Mausklick und',7,-1,seite); Inc(i);
  336.   write_to_page(0,i,' -doppelklick, insbesondere Zahlen in',7,-1,seite); Inc(i);
  337.   write_to_page(0,i,' den Seitentexten. Einfach ausprobieren',7,-1,seite); Inc(i);
  338.   write_to_page(0,i,' oder für Details in der Anleitung',7,-1,seite); Inc(i);
  339.   write_to_page(0,i,' nachschauen.',7,-1,seite); Inc(i);
  340.   writepage(seite,True);
  341. END;
  342.  
  343. PROCEDURE guru{(nr: Byte)};
  344. { Seite, die wie ein "Software Failure" aussieht :-) }
  345. VAR seite: p_onepage;
  346.     i,j,k: Integer;
  347.     s: Str80;
  348. BEGIN
  349.   WITH infopage DO BEGIN  { benutzt nicht init_page()! }
  350.     pg := 0; sp := 0;
  351.     dejavu := False;
  352.     cbits := $4A00;
  353.   END;
  354.   seite := ^infopage;
  355.   { Ist das schon eine Seite mit Guru? }
  356.   IF (seite^.chars[0]<>17) OR (seite^.chars[40]<>17) THEN
  357.     FOR i := 959 DOWNTO 160 DO  { ziemlich sicher nicht }
  358.       IF visblpage=Nil THEN
  359.         seite^.chars[i] := 32
  360.       ELSE
  361.         seite^.chars[i] := visblpage^.chars[i-160];
  362.   i := 0;
  363.   write_to_page(0,i,'<,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,l',1,-1,seite); Inc(i);
  364.   write_to_page(0,i,'5 I2C failure. Hit space to continue. j',1,-1,seite); Inc(i);
  365.   write_to_page(0,i,'5                                     j',1,-1,seite);
  366.   s := 'Err: '+intstr(nr)+'  Msg: '+i2c_error[nr];
  367.   write_to_page((41-Length(s)) DIV 2,i,s,-1,-1,seite); Inc(i);
  368.   write_to_page(0,i,'-,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,.',1,-1,seite); Inc(i);
  369.   { Steuerzeichen für die Grafik stimmen noch nicht ganz: }
  370.   FOR j := 0 TO 3 DO char_to_page(0,j,#17,seite);
  371.   FOR j := 1 TO 2 DO BEGIN
  372.     char_to_page(2,j,#1,seite); char_to_page(38,j,#17,seite); END;
  373.   writepage(seite,True);
  374.   { den Rahmen einmal blinken lassen: }
  375.   seite^.sp := 4; { nur noch 4 Zeilen ausgeben }
  376.   FOR k := 0 TO 1 DO BEGIN
  377.     FOR j := 0 TO 3 DO char_to_page(0,j,Chr(16+k),seite);
  378.     FOR j := 1 TO 2 DO char_to_page(38,j,Chr(16+k),seite);
  379.     writepage(seite,True);
  380.     Delay(25);
  381.   END;
  382. END;
  383.  
  384. BEGIN { Initialisierungsteil }
  385.   infopage.next := Nil; infopage.prev := Nil;
  386. END.
  387.