home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1014 / gepackt.exe / PD / T2BR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-09  |  11.5 KB  |  316 lines
  1. PROGRAM txt2exe_BROWSER;
  2. {
  3.  Autor : P.Fischer-Haaser
  4.          Mozartstr. 10
  5.          D-74072 Heilbronn
  6.          Tel.: 07131/81947
  7.          Fax: 07131/962843
  8. }
  9.  
  10. {$DEFINE FalscherCompiler}
  11.  
  12. {$IFNDEF Ver60}
  13.    {$ifdef Ver70}
  14.      {$undef FalscherCompiler}
  15.    {$EndIF}
  16. {$else}
  17.      {$undef FalscherCompiler}
  18. {$Endif}
  19.  
  20. {$ifdef FalscherCompiler}
  21.   BEGIN
  22.     WriteLn('Turbo/Borland Pascal Version 6.0 / 7.0 besorgen');
  23.  
  24. {$else}
  25.   {$Ifdef Ver60}
  26.  
  27.   {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
  28.   {$M 8192,0,64000}
  29.  
  30.   {$else}
  31.  
  32.   {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,R-,S-,V-,X+,Y-}
  33.   {$M 8192,0,64000}
  34.  
  35.   {$endif}
  36.  
  37. (*  keine USES-Liste notwendig, mach 'mer alles selber !! *)
  38.  
  39. (***************************************************************************)
  40.  
  41.   CONST
  42.     MAGIC = 3727;                                  { Länge von T2BR.EXE }
  43.     SeitenLaenge = 24;                             { darstellb. Zahl der Zeilen einer Seite }
  44.  
  45.     HZ : STRING [48] = #24#25'-auf/ab ■ Bild'#24#25'-Seite vor/zurück ■ ESC-Ende';
  46.  
  47.     VBASE : WORD = $B000;                          { Video-Base Adresse, default : mono }
  48.     fg : byte = 15;                                { Farb-Attribut : Zeichen Vordergr. }
  49.     bg : byte = 0;                                 { Farb-Attribut : Zeichen Hintergr. }
  50.     hfg : byte = 0;                                { Farb-Attribut : Hilfz. Vordergr. }
  51.     hbg : byte = 7;                                { Farb-Attribut : Hilfz. Hintergr. }
  52.     Zeilen : LongInt = 0;                          { Anzahl Zeilen, max 2 Mrd... }
  53.     TabOffset : LongInt = 0;                       { Offset Verweis-Tabelle }
  54.  
  55.     (***************************************************************************)
  56.  
  57.     PROCEDURE addch(VAR S : STRING; c : Char);     { hängt <c> an <s> an, ohne stack-verschwendung }
  58.     VAR
  59.       L : Byte ABSOLUTE S;
  60.     BEGIN
  61.       Inc(L);
  62.       S[L] := c;
  63.     END;                                           { addch }
  64.  
  65.     (***************************************************************************)
  66.  
  67.     FUNCTION Replicate(nr : Byte; ch : Char) : STRING;
  68.     VAR                                          { String der Länge <nr>, bestehend aus <ch> }
  69.       tmpS : STRING;
  70.     BEGIN
  71.       fillchar(tmps,succ(nr),ch);
  72.       tmps[0] := chr(nr);
  73.       Replicate := tmpS;
  74.     END;                                           { replicate }
  75.  
  76.     (***************************************************************************)
  77.  
  78.     PROCEDURE Gxy(x,y:byte); assembler;            { GotoXY }
  79.     asm
  80.       mov ax,0f00h
  81.       Int 10h
  82.       mov ax,0200h
  83.       mov dh,y
  84.       Dec dh
  85.       mov dl,x
  86.       Dec dl
  87.       Int 10h
  88.     END;                                           { Gxy }
  89.  
  90.     (***************************************************************************)
  91.  
  92.     PROCEDURE Coff; assembler;                     { Cursor OFF }
  93.     asm
  94.       mov ah,01
  95.       mov cx,2020h
  96.       Int 10h
  97.     END;                                           { Coff }
  98.  
  99.     (***************************************************************************)
  100.  
  101.     PROCEDURE Con; assembler;
  102.     asm                                            { Cursor ON }
  103.       mov ah,01
  104.       mov cx,0611h
  105.       Int 10h
  106.     END;                                           { Con }
  107.  
  108.     (***************************************************************************)
  109.  
  110.     PROCEDURE WrXYAttr(_x,_y:integer; _fg,_bg:byte; _s:STRING); assembler;
  111.                       { write string _S ab _Y,_Y mit Fraben _FG,_BG }
  112.     asm           
  113.       push ds
  114.  
  115.       mov dx,_y
  116.       Dec dx
  117.       mov cl,7
  118.       SHL dx,cl
  119.       mov ax,dx  { (y-1) * 128 }
  120.       mov dx,_y
  121.       Dec dx
  122.       mov cl,5
  123.       SHL dx,cl  { (y-1) * 32 }
  124.       add ax,dx
  125.       add ax,_x
  126.       add ax,_x
  127.       sub ax,2  { Video-Offset := (y-1)*(128+32)+(x*2)-2) }
  128.       mov di,ax { ES:DI ist Ziel }
  129.  
  130.       mov cx,VBASE
  131.       mov es,cx { Zielsegment : VBASE }
  132.  
  133.       mov dl,_bg
  134.       mov cl,4
  135.       SHL dl,cl
  136.       mov bl,dl
  137.       add bl,_fg  { Farbe : bg shl 4 + fg }
  138.  
  139.       lds si,_s   { Source in DS:SI }
  140.       cld
  141.       lodsb       { Längenbyte laden }
  142.       XOR ah,ah
  143.       xchg ax,cx  { in CX ablegen }
  144.       cmp cx,0
  145.       jz @@ende   { String 0 Zeichen lang ?? }
  146.      @@P_loop:
  147.       lodsb       { Zeichen laden }
  148.       mov ah,bl   { Attribut dazu }
  149.       stosw       { wortweise (Zeichen+attr) in das VRAM kopieren }
  150.       loop @@P_loop { CX = 0 ? --> weiter ab P_Loop }
  151.      @@ende:
  152.       pop ds
  153.     END;                                           { WRXY }
  154.  
  155.     (***************************************************************************)
  156.  
  157.     PROCEDURE HaltError(s : STRING);               { STOP, Write S, Cursor ON }
  158.     BEGIN
  159.       WrXYAttr(1,25,7,0,s);
  160.       gxy(1,25);
  161.       Con;
  162.       Halt;
  163.     END;                                           { Halterror }
  164.  
  165.     (***************************************************************************)
  166.  
  167.     PROCEDURE io;                                  { io-check }
  168.     BEGIN
  169.       IF IOResult <> 0 THEN
  170.         HaltError('IO FEHLER');
  171.     END;                                           { io }
  172.  
  173.     (***************************************************************************)
  174.  
  175.  
  176.     FUNCTION GetKey : Word; Assembler;            { Tastatur lesen }
  177.     asm
  178.       mov ah,0
  179.       Int 16h                                      { BIOS-WAITKEY }
  180.       cmp al,0
  181.       jz @@special                                 { oh, Sondertaste...}
  182.       XOR ah,ah                                    { nö, normale Taste }
  183.       jmp @@finis                                   { Fuktions-Ergebnis in AX }
  184.      @@special:
  185.       mov al,ah
  186.       XOR ah,ah
  187.       add ax,1000                                  { bei Sondertaste : 1000 hinzu...}
  188.      @@finis:                                       { Ergebnis ist in AX }
  189.     END;
  190.  
  191.     (***************************************************************************)
  192.  
  193.     PROCEDURE HilfZeile(s : STRING);
  194.     Var
  195.       SLEN : Byte Absolute S;
  196.     BEGIN
  197.       WrXYAttr(1, 25, hfg, hbg, replicate(80, #32));
  198.       WrXYAttr(1, 25, hfg, hbg ,s);
  199.     END;                                           { Hilfzeile }
  200.  
  201.     (***************************************************************************)
  202.  
  203.     PROCEDURE Display;                             { Text anzeigen und Tasten auswerten }
  204.     VAR
  205.       f : FILE;
  206.       tmpS : STRING;
  207.       chi : integer;
  208.       oben : LongInt;
  209.       dummy : word;
  210.  
  211.     (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  212.  
  213.     FUNCTION GetStr(nr : LongInt) : STRING;     { string aus Zeile NR lesen }
  214.     VAR
  215.       offs : LongInt;
  216.     BEGIN
  217.       Seek(f,TabOffset+pred(nr) SHL 2);          { Position der Zeile in Tabelle errechnen
  218.                                                    =TabellenOffset+ZeilenNr*4              }
  219.       io;
  220.       BlockRead(f, offs, sizeof(longint));       { Tabellen-Verweis auf String lesen }
  221.       Seek(f, offs);                             { jetzt auf die String-Position ... }
  222.       BlockRead(f, tmpS[0], 81);                 { und Zeile Lesen ... hier : max 81 Zeichen }
  223.                                                  { Länge stimmt, da in tmps[0]    }
  224.       GetStr := tmpS;                            { und kopiern }
  225.  
  226.     END;                                         { Display.GetStr }
  227.  
  228.     (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  229.  
  230.     PROCEDURE ShowPage(start : LongInt);         { Seite anzeigen ab Zeile : start }
  231.     VAR                                          { setzt glob. OBEN neu.. }
  232.       i : LongInt;
  233.       zl : Byte;
  234.     BEGIN
  235.       IF (start < 1) THEN start := 1;
  236.       IF (start > Zeilen-SeitenLaenge) AND (Zeilen > SeitenLaenge) THEN
  237.         start := Zeilen-SeitenLaenge;
  238.       zl := 1;
  239.       FOR i := start TO start+SeitenLaenge-1 DO
  240.         BEGIN
  241.           WrXYAttr(1,zl,fg,bg,replicate(80,' '));
  242.           IF i <= Zeilen THEN
  243.             WrXYAttr(1,zl,fg,bg,GetStr(i));
  244.           Inc(zl);
  245.         END;
  246.       oben := start;
  247.     END;                                         { Display.SHOWPAGE }
  248.  
  249.     (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  250.  
  251.     BEGIN                                          { DISPLAY }
  252.       {$i-}                                        { no i/o-abortion via RunTime-Lib }
  253.       filemode := 0;                               { r/o flag ? -> egal, TP-Open modus anpassen }
  254.       Assign(f, ParamStr(0));                      { aufgerufene Programmdatei öffnen }
  255.       Reset(f, 1);                                 { untyp. file, LRECL = 1 }
  256.       io;                                          { ALLES OK ? }
  257.  
  258.       Seek(f, MAGIC);                              { Auf Ende des Browsers positionieren...}
  259.       io;                                          { ALLES OK ? }
  260.  
  261.       BlockRead(f, Zeilen, SizeOf(longint), dummy); { Anzahl Zeilen lesen }
  262.  
  263.       BlockRead(f, TabOffset, SizeOf(longint),dummy); { Anfang der Verweis-Tabelle }
  264.       IF dummy <> SizeOf(longint) THEN
  265.         Halterror('');
  266.  
  267.       HilfZeile(HZ);
  268.       ShowPage(1);                                 { erste Seite... }
  269.       coff;
  270.  
  271.       REPEAT
  272.         chi := GetKey;                             { Tasten auswerten...}
  273.         CASE chi OF
  274.           1072 :                                   { Up }
  275.                                                      BEGIN
  276.                                                        IF oben > 1 THEN
  277.                                                          Dec(oben);
  278.                                                        showpage(oben)
  279.                                                      END;
  280.           1080 :                                   { Down }
  281.                                                      BEGIN
  282.                                                        IF oben < zeilen-seitenlaenge THEN
  283.                                                          Inc(oben);
  284.                                                        showpage(Oben)
  285.                                                      END;
  286.           1071 :                                   { Home }
  287.                                                      ShowPage(1);
  288.           1079 :                                   { End }
  289.                                                      ShowPage(Zeilen-SeitenLaenge+1);
  290.           1073 :                                   { PgUp }
  291.                                                      ShowPage(oben-SeitenLaenge);
  292.           1081 :                                   { PgDn }
  293.                                                      ShowPage(oben+SeitenLaenge);
  294.         END;
  295.       UNTIL chi = 27;                              { ESC }
  296.       Close(f);                                    { Datei schließen }
  297.       HaltError(#24)
  298.     END;                                           { Display }
  299.  
  300. (***************************************************************************)
  301. (****** M A I N ************************************************************)
  302. (***************************************************************************)
  303. BEGIN
  304.   {$i-}
  305.   IF mem[$0040:$0049] <> 7 THEN                   { Farbe oder Mono ?? }
  306.     BEGIN
  307.       VBASE := $b800;                            { Farbe }
  308.       fg := 14; bg := 1;
  309.     END;                                         { kein ELSE --> Mono ham'er scho } 
  310.  
  311.   Display;                                       { Text anzeigen }
  312.  
  313.   {$ENDIF}
  314. END.                                             { Fertig }
  315. (***************************************************************************)
  316.