home *** CD-ROM | disk | FTP | other *** search
/ Die ASC Mega 2 / ASC-Mega2-CD-ROM.iso / SPIELE / KAISER / KAUSGABE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-23  |  38.5 KB  |  1,383 lines
  1. unit Kausgabe; (* Version 4.1 *)
  2.  
  3.  
  4. interface
  5.  
  6. uses  crt,dos,screen;
  7.  
  8. type  Imagebild   = array[0..15] of word;
  9.       ImageType   = record
  10.                       breite, Hoehe: word;
  11.                       bild: Imagebild
  12.                     end;
  13. const Version = 'Version 4.2';
  14.       datum = '23.10.1992';
  15.       titel_zeile = 'KAISER  *  '+version+'  *  '+datum+'  *  by Oliver Redner';
  16.       hotkey = #59; (* F1: Taste für Sonderfunktionen *)
  17.       rebuild_key = #113;
  18.       cGaSimul = false;
  19.       cursorGestalt = '▒';
  20.       MaxLaenge = 64; (* Maximale Zahl der Einträge im Directory *)
  21.       FSb_X = 5;
  22.       FSb_Y = 7;
  23.       extension = '.KSR';
  24.       config_name = 'KAISER.CFG';
  25.       MaxLng = 57; (* Für die Pfadeingabe *)
  26.       MaxLw = 'J';
  27.       ImageLength = 34;
  28.       ZMuehle = 0;
  29.       ZMarkt = 1; (* Zeichen 1-3 *)
  30.       Laubbaum = 4;
  31.       Tanne = 5;
  32.       Geldsack = 6;
  33.       Schuldbrief = 24;
  34.       Mensch = 7;
  35.       lo = 20; (* Ecke links oben   *)
  36.       ro = 21; (* Ecke rechts oben  *)
  37.       lu = 16; (* Ecke links unten  *)
  38.       ru = 18; (* Ecke rechts unten *)
  39.       hz = 17; (* Horizontale Mauer *)
  40.       sk = 19; (* Senkrechte Mauer  *)
  41.       toro = 22; (* Oberer Torteil  *)
  42.       toru = 23; (* Unterer Torteil *)
  43.       ZweiFenster = 8;
  44.       Tuerlinks = 9;
  45.       Tuerrechts = 10;
  46.       Spitzen = 11;
  47.       Kuppel = 12;
  48.       Fahne = 13;
  49.       Kuppelfenster = 14;
  50.       Kreuz = 15;
  51.       grenze0 = 25;
  52.       grenze1 = 26;
  53.       grenze2 = 27;
  54.       grenze3 = 28;
  55.       grenze4 = 29;
  56.       z_h = 30;
  57.       z_a = 31;
  58.       z_u = 32;
  59.       z_p = 33;
  60.       z_t = 34;
  61.       z_s = 35;
  62.       z_d = 36;
  63.       z_markt2 = 37;  (* 37-38 *)
  64.       z_muehle2 = 39;
  65.       z_kirche = 40;  (* 40-41 *)
  66.       z_kuppel2 = 42;
  67.       z_spitzen2 = 43;
  68.       z_palast2 = 44;
  69.       z_kreuz2 = 45;
  70.       z_kreuz3 = 46;
  71.       z_kath2 = 47;
  72.       fl_hz = 48;
  73.       fl_lo = 49;
  74.       fl_ru = 50;
  75.       fl_lu = 51;
  76.       fl_ro = 52;
  77.       fl_str = 53;
  78.       fl_stl = 54;
  79.       fl_stu = 55;
  80.       fl_sto = 56;
  81.       z_baum1 = 57; (* 57 - 58 *)
  82.       z_baum2 = 59; (* 59 - 60 *)
  83.       z_truppen = 61-2; (* 61 - 76 *)
  84.       z_reiter1 = 62;
  85.       z_artillerie1 = 64;
  86.       z_infanterie1 = 66;
  87.       z_miliz1 = 68;
  88.       z_reiter2 = 69;
  89.       z_artillerie2 = 71;
  90.       z_infanterie2 = 73;
  91.       z_miliz2 = 75;
  92.       z_ruine = 77; (* 77 - 78 *)
  93.       z_krater = 79; (* 79 - 80 *)
  94.       z_leer   = 81;
  95.       z_cursor = 82; (* 82-83 *)
  96.       leer = Z_leer;
  97.  
  98. type  Reichstring = string[9];
  99.       Namenstring = string[20];
  100.       Titelstring = string[12];
  101.       MaxString   = string[80];
  102.       Filename    = string[13];
  103.       bauwerkTyp  = array[0..2] of byte;
  104.       control_typ = (li,re,auf,ab,bauf,bab,pos1,end_,key,ext);
  105.       menue_typ = record
  106.                     xs,ys,xl,yl,at: byte;
  107.                   end;
  108.       menue_ptr = ^menue_typ;
  109.  
  110. const norm = 7; hell = 15; inv = 7*16;
  111.       att_spec_m      = 0;                 (* 4 Attribute *)
  112.       att_abbr_r      = att_spec_m+4;
  113.       att_abbr_s      = att_abbr_r+1;
  114.       att_tit_back    = att_abbr_s+1;
  115.       att_tit_schr    = att_tit_back+1;
  116.       att_tit_tit     = att_tit_schr+1;
  117.       att_zahl        = att_tit_tit+1;
  118.       att_strg        = att_zahl+1;
  119.       att_strg_c      = att_strg+1;
  120.       att_fsb_r       = att_strg_c+1;
  121.       att_fsb_n       = att_fsb_r+1;
  122.       att_fsb_h       = att_fsb_n+1;
  123.       att_fsb_c       = att_fsb_h+1;
  124.       att_spiel_m     = att_fsb_c+1;       (* 4 Attribute *)
  125.       att_justiz_m    = att_spiel_m+4;     (* 4 Attribute *)
  126.       att_korn_m      = att_justiz_m+4;    (* 4 Attribute *)
  127.       att_zuteil_m    = att_korn_m;        (* gleich att_korn_m *)
  128.       att_einn_m      = att_zuteil_m+4;    (* 4 Attribute *)
  129.       att_einkauf_m   = att_einn_m+4;      (* 4 Attribute *)
  130.       att_militaer_m  = att_einkauf_m+4;   (* 4 Attribute *)
  131.       att_rekrut_m    = att_militaer_m;    (* gleich att_militaer_m *)
  132.       att_speicher    = att_rekrut_m+4;
  133.       att_korn_b      = att_speicher+1;
  134.       att_korn_s      = att_korn_b+1;
  135.       att_zuteil_b    = att_korn_s+1;
  136.       att_zuteil_s    = att_zuteil_b+1;
  137.       att_uebers      = att_zuteil_s+1;
  138.       att_einn_tit    = att_uebers+1;
  139.       att_einn_s      = att_einn_tit+1;
  140.       att_einn_z      = att_einn_s+1;
  141.       att_nachr       = att_einn_z+1;
  142.       att_einkauf_tit = att_nachr+1;
  143.       att_einkauf_s   = att_einkauf_tit+1;
  144.       att_spielst_tit = att_einkauf_s+1;
  145.       att_spielst_s   = att_spielst_tit+1;
  146.       att_milit_tit   = att_spielst_s+1;
  147.       att_milit_s     = att_milit_tit+1;
  148.       att_befoer_tit  = att_milit_s+1;
  149.       att_befoer_s    = att_befoer_tit+1;
  150.       att_kaiser_tit  = att_befoer_s+1;
  151.       att_kaiser_s    = att_kaiser_tit+1;
  152.       att_verhalt_m   = att_kaiser_s+1;    (* 4 Attribute *)
  153.       att_verhalt_s   = att_verhalt_m+4;
  154.       att_feind_tit   = att_verhalt_s+1;
  155.       att_feind_s     = att_feind_tit+1;
  156.       att_feind_m     = att_feind_s+1;     (* 4 Attribute *)
  157.       att_weg_tit     = att_feind_m+4;
  158.       att_weg_s       = att_weg_tit+1;
  159.       att_praemie     = att_weg_s+1;
  160.       att_verluste    = att_praemie+1;
  161. type  palette_typ     = array[0..att_verluste] of byte;
  162. const mono_palette: palette_typ =
  163.       (* spec_m *)    (norm,norm,hell,inv,
  164.       (* abbr *)       hell,hell+blink,
  165.       (* tit *)        inv,inv,norm,
  166.       (* zahl *)       inv,
  167.       (* strg *)       inv,norm,
  168.       (* fsb *)        norm,norm,hell,inv,
  169.       (* spiel_m *)    norm,norm,hell,inv,
  170.       (* justiz_m *)   norm,norm,hell,inv,
  171.       (* korn_m *)     norm,norm,hell,inv,
  172.       (* einn_m *)     norm,norm,hell,inv,
  173.       (* einkauf_m *)  norm,norm,hell,inv,
  174.       (* militaer_m *) norm,norm,hell,inv,
  175.       (* speicher *)   hell,
  176.       (* korn *)       norm,norm,
  177.       (* zuteil *)     norm,norm,
  178.       (* uebers *)     norm,
  179.       (* einn *)       inv,norm,norm,
  180.       (* nachr *)      inv,
  181.       (* einkauf *)    inv,norm,
  182.       (* spielst *)    inv,norm,
  183.       (* milit *)      inv,norm,
  184.       (* befoer *)     inv,norm,
  185.       (* kaiser *)     inv,norm,
  186.       (* verhalt_m *)  norm,norm,hell,inv,
  187.       (* verhalt_s *)  norm,
  188.       (* feind *)      inv,norm,
  189.       (* feind_m *)    norm,norm,hell,inv,
  190.       (* weg *)        inv,norm,
  191.       (* praemie *)    norm,
  192.       (* verluste *)   norm);
  193.       farb_palette: palette_typ =
  194.       (* spec_m *)    (blue*16+lightgray,blue*16+lightgray,blue*16+lightred,lightgray*16+blue,
  195.       (* abbr *)       red*16+white,red*16+white+blink,
  196.       (* tit *)        brown*16+lightgray,brown*16+white,lightgray*16,
  197.       (* zahl *)       blue*16+white,
  198.       (* strg *)       green*16+white,red*16+green,
  199.       (* fsb *)        red*16+yellow,red*16+lightgray,red*16+white,red+lightgray*16,
  200.       (* spiel_m *)    16*lightgray,16*lightgray,lightgray*16+yellow,white+16*red,
  201.       (* justiz_m *)   blue*16+red,blue*16+lightgray,blue*16+white,red*16+lightgray,
  202.       (* korn_m *)     16*lightgray,16*lightgray,lightgray*16+yellow,white+16*red,
  203.       (* einn_m *)     green*16+red,green*16,green*16+white,red*16+green,
  204.       (* einkauf_m *)  brown*16+lightgray,brown*16+lightgray,brown*16+white,lightgray*16+brown,
  205.       (* militaer_m *) brown*16+lightgray,brown*16+lightgray,brown*16+white,lightgray*16+brown,
  206.       (* speicher *)   brown*16+yellow,
  207.       (* korn *)       brown*16+lightgray,brown*16+white,
  208.       (* zuteil *)     lightgray*16,lightgray*16+red,
  209.       (* uebers *)     brown*16+lightgray,
  210.       (* einn *)       green*16,16*lightgray+blue,16*lightgray+red,
  211.       (* nachr *)      red*16+white,
  212.       (* einkauf *)    blue*16+lightgray,lightgray*16+blue,
  213.       (* spielst *)    blue*16+lightgray,lightgray*16+blue,
  214.       (* milit *)      blue*16+lightgray,lightgray*16+blue,
  215.       (* befoer *)     blue*16+lightgray,lightgray*16+blue,
  216.       (* kaiser *)     blue*16+lightgray,lightgray*16+blue,
  217.       (* verhalt_m *)  brown*16+lightgray,brown*16+lightgray,brown*16+white,lightgray*16+brown,
  218.       (* verhalt_s *)  blue*16+lightgray,
  219.       (* feind *)      lightgray*16+blue,blue*16+lightgray,
  220.       (* feind_m *)    brown*16+lightgray,brown*16+lightgray,brown*16+white,lightgray*16+brown,
  221.       (* weg *)        lightgray*16+blue,blue*16+lightgray,
  222.       (* praemie *)    blue*16+lightgray,
  223.       (* verluste *)   blue*16+lightgray);
  224.  
  225.  
  226. var i,j:             text;
  227.     SavePath:        PathStr;
  228.     XWeite,YWeite:   word;
  229.     rebuild,langsam: boolean;
  230.     graphmode,textmode:     procedure;
  231.     row:                    procedure (a: byte);
  232.     mal:                    procedure (a: byte; b: word; c: byte);
  233.     horline,verline,scroll: procedure (a,b,c: word);
  234.     outtext:                procedure (a: byte; b: word; c: string);
  235.     kugel:                  procedure (a,b: word);
  236.  
  237.     att:                    palette_typ;
  238.  
  239. {$I kextrn}
  240.  
  241.  
  242. type cfgtyp = record
  243.                 soundf,autosave: boolean;
  244.               end;
  245.  
  246. const cfg: cfgtyp = (soundf:  true;
  247.                      autosave:true);
  248.  
  249. procedure Titelschirm;
  250. procedure KeineTaste;
  251. procedure Wait;
  252. procedure Rahmen (att: byte);
  253. procedure Rand (att: byte);
  254. procedure clear(x1,x2,y1,y2,att: byte);
  255. procedure Hinweis(Text: MaxString);
  256. procedure cursor(an_aus: boolean);
  257. procedure Taste_druecken;
  258. procedure NeuerKaiser(var Name: MaxString);
  259. procedure NeuerTitelSound;
  260. procedure NachrichtSound;
  261. procedure OpenGraph;
  262. procedure ShutGraph;
  263. procedure midtext(y: word; s: maxstring);
  264. procedure wipetext(x,y: word; anzahl: byte);
  265. procedure sub0_int(var zahl1: integer; zahl2: integer);
  266. procedure rectangle(x1,y1,x2,y2: word);
  267. procedure lies (var control: control_typ; var taste: char; num_pad: boolean);
  268. procedure waehlen (menue: menue_ptr; var wahl: byte);
  269. procedure Warte(Laenge: longint);
  270. function alterKaiser: MaxString;
  271. function MomentZeit: longint;
  272. function Strg(Zahl: longint): string;
  273. function StrgR(Zahl: longint; Laenge: byte): string;
  274. function eingabe(Stellen: byte; Text: MaxString): longint;
  275. function eingcapStr(Laenge: byte): MaxString;
  276. function eingstring(laenge: byte): maxstring;
  277. function Lowercase(Zeichen: char): char;
  278. function Uppercase(Zeichen: char): char;
  279. function min(Zahl1, Zahl2: byte): byte;
  280. function fileselect(wildcard: filename; var path: dirstr): pathstr;
  281. function eingFilename: PathStr;
  282. function Ja: boolean;
  283. function Numerus(Zahl: longint; einzahl, endung: MaxString): MaxString;
  284. function SgPl(Zahl: longint; einzahl, Mehrzahl: MaxString): MaxString;
  285. function clog(von: real): real;
  286. function readkey: char;
  287.  
  288.  
  289. implementation
  290.  
  291.  
  292. type Toene = (c,cis,d,dis,e,f,fis,g,gis,a,b,h);
  293.  
  294. const Hoehe: array[Toene] of word =
  295.       (10465, 11087, 11747, 12445, 13185, 13969,
  296.        14800, 15680, 16613, 17600, 18647, 19755);
  297.  
  298.       Ganze = 150;
  299.  
  300. type rettbildtyp  = object
  301.                       bild:    ^crt_screen_type;
  302.                       grafik:  pointer;
  303.                       groesse: word;
  304.                       aktiv:   boolean;
  305.                       constructor sichern;
  306.                       destructor wiederherstellen;
  307.                     end;
  308.      rettbildptr  = ^rettbildtyp;
  309.      karten_typen = (keine,hgc,cga,ega);
  310.      string2      = string[2];
  311.  
  312. var oktavefaktor:                 byte;
  313.     nextchar:                     char;
  314.     spec_funx_aktiv,grafik_aktiv,
  315.     ueberlapp:                    boolean;
  316.     grafikkarte:                  karten_typen;
  317.     save_size:                    word;
  318.     scr_save,scr_restore:         procedure (a: pointer);
  319.  
  320.  
  321. constructor rettbildtyp.sichern;
  322. begin
  323.   aktiv:=grafik_aktiv;
  324.   if grafik_aktiv
  325.     then begin
  326.       if ueberlapp then
  327.         if (save_size>0) and (maxavail>=save_size)
  328.           then begin getmem(grafik,save_size); scr_save (grafik); end
  329.           else grafik:=nil;
  330.       textmode;
  331.       grafik_aktiv:=false;
  332.     end else
  333.       if maxavail>=sizeof(bild)
  334.         then begin new(bild); bild^:=crt_screen^; end
  335.         else bild:=nil;
  336. end;
  337.  
  338. destructor rettbildtyp.wiederherstellen;
  339. begin
  340.   grafik_aktiv:=aktiv;
  341.   if grafik_aktiv
  342.     then begin
  343.       auto_cls:=false; graphmode;
  344.       if ueberlapp and (grafik<>nil) then begin
  345.         scr_restore (grafik); freemem(grafik,save_size);
  346.       end;
  347.     end else if bild<>nil then begin
  348.       crt_screen^:=bild^; dispose(bild)
  349.     end;
  350. end;
  351.  
  352.  
  353. {$F+}
  354. function video_adapter: byte; external;
  355. {$L vidadapt}
  356.  
  357. {$I kgraph} {$L kgraph}
  358. {$F-}
  359.  
  360.  
  361. function MomentZeit: longint;
  362. var h,m,s,hund: word;
  363. begin
  364.   GetTime(h, m, s, hund);
  365.   Momentzeit := h*360000+m*6000+s*100+hund
  366. end;
  367.  
  368.  
  369. procedure Warte(Laenge: longint);
  370. var Start, Zeit1, Zeit2: longint;
  371. begin
  372.   Start := Momentzeit;
  373.   Zeit1 := Start + Laenge;
  374.   repeat
  375.     Zeit2 := Momentzeit;
  376.   until (Zeit2 > Zeit1) or (Zeit2 < Start)
  377. end;
  378.  
  379. procedure Play(Ton: Toene; Laenge, Pause: word);
  380. begin
  381.   sound(Hoehe[Ton] div OktaveFaktor);
  382.   warte(Ganze div Laenge);
  383.   nosound;
  384.   if Pause > 0 then
  385.     warte(Ganze div Pause)
  386. end;
  387.  
  388.  
  389. procedure Oktave(OktavNr: byte);
  390. begin
  391.   OktaveFaktor := 256 shr OktavNr
  392. end;
  393.  
  394.  
  395. procedure waehlen (menue: menue_ptr; var wahl: byte);
  396. var y,attr,cx: byte;
  397.     s:         maxstring;
  398.     control:   control_typ;
  399.     taste:     char;
  400.     ende:      boolean;
  401.  
  402. procedure suchen (zeichen: char);
  403. var lauf,i: byte;
  404.     found:  boolean;
  405.     s:      maxstring;
  406. begin
  407.   with menue^ do begin
  408.     found:=false; lauf:=wahl;
  409.     repeat
  410.       move(mem[seg(menue^):ofs(menue^)+sizeof(menue_typ)+pred(lauf)*(xl+2)],s,xl+2);
  411.       for i:=1 to length(s) do s[i]:=upcase(s[i]);
  412.       if pos('^'+zeichen,s)>0 then found:=true
  413.                               else begin
  414.                                 inc(lauf); if lauf>yl then lauf:=1;
  415.                               end;
  416.     until found or (lauf=wahl);
  417.   end;
  418.   if found then begin wahl:=lauf; ende:=true; end
  419.            else inc(wahl);
  420. end;   (* suchen *)
  421.  
  422. procedure zeile (y: byte);
  423. var x: byte;
  424. begin
  425.   with menue^ do begin
  426.     setattr (ys+y,xs,xl,att[succ(at)]);
  427.     move(mem[seg(menue^):ofs(menue^)+sizeof(menue_typ)+y*(xl+2)],s,xl+2);
  428.     attr:=att[succ(at)]; cx:=xs;
  429.     for x:=1 to length(s) do
  430.       if s[x]='^' then attr:=att[at+2]
  431.                   else begin
  432.                     wp(crt_screen)^[ys+y,cx]:=ord(s[x])+swap(attr);
  433.                     attr:=att[succ(at)]; inc(cx);
  434.                   end;
  435.   end;
  436. end;   (* zeile *)
  437.  
  438. begin  (* waehlen *)
  439.   ende:=false;
  440.   with menue^ do begin
  441.     box (all_single_box,pred(xs),pred(ys),xl,yl,att[at],att[succ(at)]);
  442.     for y:=0 to pred(yl) do zeile (y);
  443.     repeat
  444.       setattr (ys+pred(wahl),xs,xl,att[at+3]);
  445.       lies (control,taste,true);
  446.       zeile (pred(wahl));
  447.       case control of
  448.         li,auf: dec(wahl);
  449.         re,ab:  inc(wahl);
  450.         pos1:   wahl:=1;
  451.         end_:   wahl:=yl;
  452.         key:    case upcase(taste) of
  453.                   #13: ende:=true;
  454.                   #27: begin wahl:=0; ende:=true; end;
  455.                   else suchen (upcase(taste));
  456.                 end;
  457.       end;
  458.       if not ende then begin
  459.         if wahl<1 then wahl:=yl;
  460.         if wahl>yl then wahl:=1;
  461.       end;
  462.     until ende;
  463.     if wahl>0 then setattr (ys+pred(wahl),xs,xl,att[at+2]);
  464.   end;
  465. end;   (* waehlen *)
  466.  
  467.  
  468. procedure schreibe_titelzeile;
  469. begin
  470.   clrscr; writeln(titel_zeile); writeln;
  471. end;
  472.  
  473.  
  474. procedure parameter_auswerten;
  475. const ungueltig        = 'Ungültiger Parameter: ';
  476.       unbekannte_karte = 'Unbekannte Grafikkarte: ';
  477.       unbekannt        = 'Unbekannter Parameter: ';
  478.       ueberfluessig    = 'Überflüssiger Parameter: ';
  479. var   s:                 maxstring;
  480.       lauf:              word;
  481.       i:                 byte;
  482.  
  483. procedure hilfe (text: maxstring);
  484. begin
  485.   schreibe_titelzeile; writeln(text); writeln;
  486.   writeln('Aufruf: KAISER [Parameter]'); writeln;
  487.   writeln('        [Parameter]: /GH  Hercules-Grafik benutzen');
  488.   writeln('                       C  CGA-Grafik benutzen');
  489.   writeln('                       E  EGA-Grafik benutzen');
  490.   writeln('                     /H   Diese Hilfe erscheint');
  491.   writeln;
  492.   halt;
  493. end;   (* hilfe *)
  494.  
  495. procedure fragen;
  496. var taste: char;
  497. begin
  498.   clrscr; writeln(titel_zeile); writeln;
  499.   writeln('Welche Grafikkarte ist angeschlossen?'); writeln;
  500.   writeln('   1 ... Hercules');
  501.   writeln('   2 ... CGA');
  502.   writeln('   3 ... EGA');
  503.   repeat
  504.     taste:=crt.readkey;
  505.     if taste=#27 then halt;
  506.   until (taste>='1') and (taste<='3');
  507.   grafikkarte:=karten_typen(ord(taste)-ord('0'));
  508. end;   (* fragen *)
  509.  
  510. begin  (* parameter_auswerten *)
  511.   grafikkarte:=keine;
  512.   if paramcount>0 then for lauf:=1 to paramcount do begin
  513.     s:=paramstr(lauf); for i:=1 to length(s) do s[i]:=upcase(s[i]);
  514.     if not (s[1] in ['/','-'])
  515.       then hilfe (ungueltig+s)
  516.       else case s[2] of
  517.         'G': begin
  518.                if grafikkarte<>keine then hilfe (ueberfluessig+s);
  519.                case s[3] of
  520.                  'H': grafikkarte:=hgc;
  521.                  'C': grafikkarte:=cga;
  522.          'E': grafikkarte:=ega;
  523.                  else hilfe (unbekannte_karte+s);
  524.                end;
  525.              end;
  526.         'H': hilfe ('Hilfe:');
  527.         else hilfe (unbekannt+s);
  528.     end;
  529.   end;
  530.   if grafikkarte=keine then case video_adapter of
  531.     1:   fragen;           (* MDA  *)
  532.     2:   grafikkarte:=cga; (* CGA  *)
  533.     3:   grafikkarte:=hgc; (* HGC  *)
  534.     4:   grafikkarte:=ega; (* EGA  *)
  535.     5:   fragen;           (* MCGA *)
  536.     6:   grafikkarte:=ega; (* VGA  *)
  537.     else fragen;
  538.   end;
  539. end;   (* parameter_auswerten *)
  540.  
  541. procedure load_config;
  542. var f: file;
  543. begin
  544.   assign(f,config_name);
  545.   reset(f,sizeof(cfgtyp));
  546.   blockread(f,cfg,1);
  547.   close(f);
  548. end;
  549.  
  550.  
  551. procedure save_config;
  552. var f: file;
  553. begin
  554.   assign(f,config_name);
  555.   rewrite(f,sizeof(cfgtyp));
  556.   blockwrite(f,cfg,1);
  557.   close(f);
  558. end;
  559.  
  560.  
  561.  
  562. function specialfunx: boolean;
  563. const spec_m:    menue_typ = (xs:28;ys:10;xl:23;yl:5;at:att_spec_m);
  564.       spec_m_tx: array[1..5] of string[24] =
  565.         ('    ^Sound:     ',
  566.          '    ^Auto Save: ',
  567.          '^Konfiguration Speichern',
  568.          '    KAISER ^beenden',
  569.          '   Spiel ^Fortsetzen');
  570.       an_aus: array[boolean] of string[3] = ('aus',' an');
  571. var auswahl,y:  byte;
  572.     rettscreen: rettbildptr;
  573.     carry:      boolean;
  574.  
  575. procedure abbruch;
  576. var Taste:      char;
  577.     y:          byte;
  578.     rettscreen: rettbildptr;
  579. begin   (* abbruch *)
  580.   new(rettscreen,sichern);
  581.   box(all_double_box,12,11,55,1,att[att_abbr_r],att[att_abbr_s]);
  582.   wr(12,14,att[att_abbr_s],'Druecken Sie ESC, wenn Sie wirklich abbrechen wollen!');
  583.   taste:=crt.readkey;
  584.   if taste=#27 then begin
  585.     textattr:=lightgray; clrscr;
  586.     writeln; writeln;
  587.     wrm(0,40,lightgray*16,' Bis zum nächsten KAISER Spiel ... ');
  588.     cursor(true);
  589.     halt
  590.   end;
  591.   dispose(rettscreen,wiederherstellen);
  592. end;   (* abbruch *)
  593.  
  594. begin (* Special Funx *)
  595.   if spec_funx_aktiv then exit;
  596.   spec_funx_aktiv:=true; specialfunx:=false;
  597.   new(rettscreen,sichern); carry:=rebuild;
  598.   auswahl:=5;
  599.   repeat
  600.     with cfg do begin
  601.       spec_m_tx[1]:=copy(spec_m_tx[1],1,16)+an_aus[soundf];
  602.       spec_m_tx[2]:=copy(spec_m_tx[2],1,16)+an_aus[autosave];
  603.       waehlen (@spec_m,auswahl);
  604.       case auswahl of
  605.         1: soundf:=not soundf;
  606.         2: autosave:=not autosave;
  607.         3: save_config;
  608.         4: abbruch;
  609.       end;
  610.     end;
  611.   until auswahl in [0,5];
  612.   dispose(rettscreen,wiederherstellen); rebuild:=carry;
  613.   spec_funx_aktiv:=false;
  614.   if grafik_aktiv and ueberlapp and (save_size=0) then specialfunx:=true;
  615. end; (* Special Funx *)
  616.  
  617.  
  618. procedure Titelschirm;
  619. begin
  620.   rahmen (att[att_tit_back]);
  621.   wrm(1,40,att[att_tit_tit],' * * *  K A I S E R  * * * ');
  622.   wr(1,2,att[att_tit_back],Version);
  623.   wrr(1,77,att[att_tit_back],'von Oliver Redner');
  624.   wrm(23,40,att[att_tit_back],'Drücken Sie während des Spiels F1 für die Sonderfunktionen');
  625.   wrm(4,40,att[att_tit_back],
  626.     'KAISER wurde vom ATARI 800 XL - dort in ATARI BASIC geschrieben - in');
  627.   wrm(5,40,att[att_tit_back],'Turbo-Pascal umgesetzt.  Programmierbeginn am 26.12.1989.');
  628.   wr(7,10,att[att_tit_back],Version);
  629.   wrr(7,70,att[att_tit_back],datum);
  630.   wrm(9,40,att[att_tit_back],'Sie dürfen und sollen KAISER an andere Computerbesitzer weitergeben.');
  631.   wrm(11,40,att[att_tit_back],'Wenn Ihnen dieses Programm gefällt, schicken Sie dem Programmierer einen');
  632.   wrm(12,40,att[att_tit_back],'beliebigen Geldbetrag für seine Mühe.  Danke!');
  633.   wrm(14,40,att[att_tit_back],'Lesen Sie unbedingt KAISER.TXT!');
  634.   wrm(16,40,att[att_tit_back],'Meine Adresse:      Oliver Redner');
  635.   wr(17,44,att[att_tit_back],'Ludwigsaue 37');
  636.   wr(18,44,att[att_tit_back],'3000 Hannover 51');
  637. end;
  638.  
  639.  
  640. procedure KeineTaste;
  641. var Taste: char;
  642. begin
  643.   while keypressed do
  644.     Taste:=crt.readkey
  645. end;
  646.  
  647. procedure Wait;
  648. var Taste: char;
  649. begin
  650.   KeineTaste;
  651.   Taste:=readkey;
  652.   if Taste = #0 then
  653.     taste:=readkey;
  654. end;
  655.  
  656.  
  657. procedure clear(x1,x2,y1,y2,att: byte);
  658. var x,y: byte;
  659. begin
  660.   for y:=y1 to y2 do
  661.     for x:=x1 to x2 do begin
  662.       crt_screen^[y,x,0]:=' '; crt_screen^[y,x,1]:=chr(att);
  663.     end;
  664. end;
  665.  
  666.  
  667. procedure Rand (att: byte);
  668. begin
  669.   box(all_single_box,0,0,78,23,att,att)
  670. end;
  671.  
  672.  
  673. procedure Rahmen (att: byte);
  674. begin
  675.   rand (att);
  676.   box(all_single_box,0,0,78,1,att,att);
  677.   wr(2,0,att,'├'); wr(2,79,att,'┤')
  678. end;
  679.  
  680.  
  681. procedure Hinweis(Text: MaxString);
  682. var x,att:      byte;
  683.     rettscreen: rettbildptr;
  684. begin
  685.   new(rettscreen,sichern);
  686.   att:=ord(crt_screen^[24,0,1]);
  687.   x:=(80-length(text)) div 2;
  688.   wr(24,x-2,att,'┤ ');
  689.   wr(24,x+length(Text),att,' ├');
  690.   wr(24,x,att,Text);
  691.   setattr(24,x,length(text),att+blink);
  692.   wait;
  693.   dispose(rettscreen,wiederherstellen);
  694. end;
  695.  
  696.  
  697. procedure cursor(an_aus: boolean);
  698.  
  699. var Regs: Registers;
  700.  
  701. begin
  702.   with Regs do begin
  703.     if an_aus then
  704.       cX:=$0C0D
  705.     else
  706.       cX:=$1000;
  707.     aX:=$0100;
  708.     Intr($10,dos.Registers(Regs));
  709.   end
  710. end;
  711.  
  712. procedure Taste_druecken;
  713. begin
  714.   Hinweis('Bitte eine Taste drücken !!!')
  715. end;
  716.  
  717.  
  718. procedure NeuerKaiser(var Name: MaxString);
  719. var x: byte;
  720. begin
  721.   for x:=1 to length(Name) do
  722.     Name[x] := Uppercase(Name[x]);
  723.   rewrite(i);
  724.   writeln(i, Name);
  725.   close(i)
  726. end;
  727.  
  728. procedure NeuerTitelSound;
  729. var x,y: byte;
  730. begin
  731.   Oktave(3);
  732.   for x:=1 to 2 do begin
  733.     for y:=1 to 5 do
  734.       play(d, 16, 32);
  735.     play(g, 16, 8)
  736.   end;
  737.   for x:=1 to 4 do
  738.     play(d, 16, 32);
  739.   play(g, 16, 32);
  740.   play(g, 16, 32);
  741.   play(h, 16, 32);
  742.   play(g, 16, 0)
  743. end;
  744.  
  745. procedure NachrichtSound;
  746. var x: byte;
  747. begin
  748.   Oktave(3);
  749.   for x:=1 to 3 do
  750.     Play(a, 4, 0);
  751.   Play(d, 2, 4);
  752.   for x:=1 to 3 do
  753.     Play(h, 4, 0);
  754.   Play(g, 2, 0)
  755. end;
  756.  
  757.  
  758. procedure opengraph;
  759. begin
  760.   auto_cls:=true; graphmode;
  761.   grafik_aktiv:=true; xorput:=false;
  762. end;
  763.  
  764.  
  765. procedure shutgraph;
  766. begin
  767.   textmode; grafik_aktiv:=false;
  768. end;
  769.  
  770.  
  771. procedure midtext(y: word; s: maxstring);
  772. begin
  773.   outtext(((succ(xweite) shr 3)-length(s)) shr 1,y,s)
  774. end;
  775.  
  776.  
  777. procedure wipetext(x,y: word; anzahl: byte);
  778. var s: string;
  779.     i: byte;
  780. begin
  781.   s[0]:=chr(anzahl); fillchar(s[1],anzahl,' ');
  782.   outtext(x shr 3,y,s);
  783. end;
  784.  
  785.  
  786. procedure sub0_int(var zahl1: integer; zahl2: integer);
  787. begin
  788.   if zahl2>zahl1 then
  789.     zahl1:=0
  790.   else
  791.     dec(zahl1,zahl2);
  792. end;
  793.  
  794.  
  795. procedure grafik_init;
  796. var f:                 file;
  797.     size:              longint;
  798.     textfont,graffont: pathstr;
  799.  
  800. procedure fatal(text: maxstring);
  801. begin
  802.   schreibe_titelzeile;
  803.   writeln(text); writeln; halt;
  804. end;
  805.  
  806. begin
  807.   case grafikkarte of
  808.     hgc: begin
  809.            textfont:='KAIS8X8.FNT'; graffont:='KAISHGC.FNT';
  810.            crt_screen:=ptr($B000,0); att:=mono_palette;
  811.            graphmode:=hgc_graphmode; textmode:=hgc_textmode;
  812.            horline:=hgc_horline; verline:=hgc_verline;
  813.        outtext:=hgc_text; mal:=hgc_mal; row:=hgc_row;
  814.            kugel:=hgc_kugel;
  815.            xweite:=719; yweite:=347; farbe:=1;
  816.            langsam:=false; ueberlapp:=false;
  817.          end;
  818.     cga: begin
  819.            textfont:='KAIS8X8.FNT'; graffont:='KAISHGC.FNT';
  820.            crt_screen:=ptr($B800,0); att:=farb_palette;
  821.            graphmode:=cga_graphmode; textmode:=cga_textmode;
  822.            horline:=cga_horline; verline:=cga_verline;
  823.        outtext:=cga_text; mal:=cga_mal; row:=cga_row;
  824.            kugel:=cga_kugel; scr_save:=cga_save; scr_restore:=cga_restore;
  825.            xweite:=639; yweite:=199; farbe:=1;
  826.            langsam:=false; ueberlapp:=true; save_size:=16000;
  827.      end;
  828.     ega: begin
  829.            textfont:='KAIS8X8.FNT'; graffont:='KAISEGA.FNT';
  830.            crt_screen:=ptr($B800,0); att:=farb_palette;
  831.            graphmode:=ega_graphmode; textmode:=ega_textmode;
  832.            horline:=ega_horline; verline:=ega_verline;
  833.        outtext:=ega_text; mal:=ega_mal; row:=ega_row;
  834.            kugel:=ega_kugel; scroll:=ega_scroll;
  835.            xweite:=639; yweite:=349; farbe:=7;
  836.            langsam:=true; ueberlapp:=true; save_size:=0;
  837.            palette:=@palette1;att[att_speicher]:=brown*16+cyan;
  838.          end;
  839.     else halt;
  840.   end;
  841.   assign(f,textfont); reset(f,1);
  842.   if ioresult<>0 then fatal(textfont+' nicht gefunden!');
  843.   size:=filesize(f); getmem(text_satz,size);
  844.   blockread(f,text_satz^,size);
  845.   if ioresult<>0 then fatal(textfont+' fehlerhaft!');
  846.   close(f);
  847.   assign(f,graffont); reset(f,1);
  848.   if ioresult<>0 then fatal(graffont+' nicht gefunden!');
  849.   size:=filesize(f); getmem(graf_satz,size);
  850.   blockread(f,graf_satz^,size);
  851.   if ioresult<>0 then fatal(graffont+' fehlerhaft!');
  852.   close(f);
  853.   opengraph; shutgraph;
  854. end;   (* grafik_init *)
  855.  
  856.  
  857. procedure rectangle(x1,y1,x2,y2: word);
  858. begin
  859.   horline(x1,x2,y1); horline(x1,x2,y2);
  860.   verline(x1,y1,y2); verline(x2,y1,y2);
  861. end;
  862.  
  863.  
  864. procedure lies (var control: control_typ; var taste: char; num_pad: boolean);
  865. begin
  866.   taste:=readkey;
  867.   if taste=#0
  868.     then begin
  869.       taste:=readkey;
  870.       case ord(taste) of
  871.         72:  control:=auf;
  872.         80:  control:=ab;
  873.         75:  control:=li;
  874.         77:  control:=re;
  875.         73:  control:=bauf;
  876.         81:  control:=bab;
  877.         71:  control:=pos1;
  878.         79:  control:=end_;
  879.         else control:=ext;
  880.       end;
  881.     end else
  882.       if num_pad
  883.         then case taste of
  884.                '8': control:=auf;
  885.                '2': control:=ab;
  886.                '4': control:=li;
  887.                '6': control:=re;
  888.                '9': control:=bauf;
  889.                '3': control:=bab;
  890.                '7': control:=pos1;
  891.                '1': control:=end_;
  892.                else control:=key;
  893.              end
  894.         else control:=key;
  895. end;   (* lies *)
  896.  
  897.  
  898. function alterKaiser: MaxString;
  899. var Name: MaxString;
  900. begin
  901.   reset(i);
  902.   readln(i, Name);
  903.   close(i);
  904.   alterKaiser := Name
  905. end;
  906.  
  907.  
  908. function Strg(Zahl: longint): string;
  909. var s: string;
  910. begin
  911.   str(Zahl, s);
  912.   Strg := s
  913. end;
  914.  
  915. function StrgR(Zahl: longint; Laenge: byte): string;
  916. var s: string;
  917. begin
  918.   str(Zahl:Laenge,s);
  919.   StrgR := s
  920. end;
  921.  
  922.  
  923. function eingabe(Stellen: byte; Text: MaxString): longint;
  924.  
  925. var X,XZahl :    byte;
  926.     Zahl:        array [1..8] of char;
  927.     Taste:       char;
  928.     Wert,Potenz: longint;
  929.     rettscreen:  rettbildptr;
  930.  
  931. begin
  932.   new(rettscreen,sichern);
  933.   KeineTaste;
  934.   x := (76 - length(Text)) div 2;
  935.   box(all_single_box,x,10,length(text)+2,3,att[att_zahl],att[att_zahl]);
  936.   box(all_single_box,x,12,length(text)+2,1,att[att_zahl],att[att_zahl]);
  937.   crt_screen^[12, x, 0] := '├';
  938.   crt_screen^[12, x+length(Text)+3, 0] := '┤';
  939.   wr(11,x+2,att[att_zahl],text);
  940.   XZahl := round( (80 - Stellen) / 2) + Stellen;
  941.   for x:=1 to Stellen do
  942.     Zahl[x] := '0';
  943.   repeat
  944.     for x:= 1 to Stellen do
  945.       crt_screen^[13, XZahl-x, 0] := Zahl[x];
  946.     Taste := ReadKey;
  947.     case Taste of
  948.       '0'..'9': begin
  949.                   for x:=Stellen-1 downto 1 do
  950.                     Zahl[x+1] := Zahl[x];
  951.                   Zahl[1] := Taste
  952.                 end;
  953.       #8:       begin
  954.                   for x:=2 to Stellen do
  955.                     Zahl[x-1] := Zahl[x];
  956.                   Zahl[Stellen] := '0'
  957.                 end;
  958.       #0:       taste:=readkey;
  959.     end
  960.   until Taste in [#13,#27];
  961.   if Taste = #13 then begin
  962.     Wert := 0; Potenz := 1;
  963.     for x:=1 to Stellen do begin
  964.       Wert := Wert + Potenz * (ord(Zahl[x])-ord('0'));
  965.       Potenz := Potenz * 10
  966.     end;
  967.     eingabe := Wert end
  968.   else
  969.     eingabe := 0;
  970.   dispose(rettscreen,wiederherstellen);
  971. end;
  972.  
  973.  
  974. function Uppercase(Zeichen: char): char;
  975. begin
  976.   case Zeichen of
  977.     'ä':      Uppercase := 'Ä';
  978.     'ö':      Uppercase := 'Ö';
  979.     'ü':      Uppercase := 'Ü'
  980.     else      Uppercase := upcase(Zeichen)
  981.   end
  982. end;
  983.  
  984.  
  985. function Lowercase(Zeichen: char): char;
  986. begin
  987.   case Zeichen of
  988.     'A'..'Z': Lowercase := chr(ord(Zeichen)+(ord('a') - ord('A')));
  989.     'Ä':      Lowercase := 'ä';
  990.     'Ö':      Lowercase := 'ö';
  991.     'Ü':      Lowercase := 'ü'
  992.     else      Lowercase := Zeichen
  993.   end
  994. end;
  995.  
  996.  
  997.  
  998.  
  999. function eingstring (laenge: byte): maxstring;
  1000. const eing_y           = 13;
  1001. var   s,s2:              maxstring;
  1002.       eing_x,alt_lng,cs: byte;
  1003.       control:           control_typ;
  1004.       taste:             char;
  1005.       rettscreen:        rettbildptr;
  1006. begin
  1007.   new(rettscreen,sichern);
  1008.   eing_x:=(78-laenge) div 2;
  1009.   box(all_single_box,pred(eing_x),pred(eing_y),succ(laenge),1,att[att_strg],att[att_strg]);
  1010.   s:=''; alt_lng:=0; cs:=length(s);
  1011.   repeat
  1012.     if length(s)<alt_lng then wischen (eing_y,eing_x,succ(laenge),att[att_strg]);
  1013.     wr(eing_y,eing_x,att[att_strg],s+' ');
  1014.     crt_screen^[eing_y,eing_x+cs,1]:=chr(att[att_strg_c]);
  1015.     alt_lng:=length(s);
  1016.     lies (control,taste,false);
  1017.     case control of
  1018.       li:   if cs>0 then dec(cs);
  1019.       re:   if cs<alt_lng then inc(cs);
  1020.       pos1: cs:=0;
  1021.       end_: cs:=alt_lng;
  1022.       key:  case taste of
  1023.               #8:      if (cs>0) and (alt_lng>0) then begin
  1024.                          delete(s,cs,1); dec(cs);
  1025.                        end;
  1026.               #13,#27: ;
  1027.               else     if length(s)<laenge then begin
  1028.                          s2:=''; if cs>0 then s2:=copy(s,1,cs);
  1029.                          s2:=s2+taste;
  1030.                          if cs<alt_lng then s2:=s2+copy(s,succ(cs),alt_lng-cs);
  1031.                          s:=s2; inc(cs);
  1032.                        end;
  1033.             end;
  1034.       ext:  case ord(taste) of
  1035.               83: if (alt_lng>0) and (cs<alt_lng) then delete(s,succ(cs),1);
  1036.             end;
  1037.     end;
  1038.   until taste in [#13,#27];
  1039.   if taste=#27 then eingstring:=''
  1040.                else eingstring:=s;
  1041.   dispose(rettscreen,wiederherstellen);
  1042. end;  (* eingstring *)
  1043.  
  1044.  
  1045. function eingFilename: PathStr;
  1046. (* Eingabe eines Filenamens OHNE Extension mit Suchpfad *)
  1047.  
  1048. var s: PathStr;
  1049.     x: byte;
  1050.  
  1051. begin
  1052.   s := eingString(40);
  1053.   if s <> '' then begin
  1054.     s := Fexpand(s);
  1055.     x := pos('.',s);
  1056.     if x <> 0 then
  1057.       delete(s, x, length(s) - x + 1)
  1058.   end;
  1059.   eingFilename := s
  1060. end;
  1061.  
  1062.  
  1063.  
  1064. function eingcapStr(Laenge: byte): MaxString;
  1065.  
  1066. var s: MaxString;
  1067.     x: byte;
  1068.  
  1069. begin
  1070.   s := eingString(Laenge);
  1071.   if s <> ''then begin
  1072.     s[1] := Uppercase(s[1]);
  1073.     if length(s) > 1 then
  1074.       for x:=2 to length(s) do
  1075.         if s[x-1] = ' ' then
  1076.           s[x] := Uppercase(s[x])
  1077.         else
  1078.           s[x] := Lowercase(s[x]);
  1079.     while s[length(s)] = ' ' do
  1080.       delete(s, length(s),  1)
  1081.   end;
  1082.   eingcapStr := s
  1083. end;
  1084.  
  1085.  
  1086. function min(Zahl1, Zahl2: byte): byte;
  1087. begin
  1088.   if Zahl1 > Zahl2 then
  1089.     min := Zahl2
  1090.   else
  1091.     min := Zahl1
  1092. end;
  1093.  
  1094.  
  1095. function fileselect(wildcard: filename; var path: dirstr): pathstr;
  1096. type  eintrag_ptr    = ^eintragrec;
  1097.       eintrag_ptr_ad = ^eintrag_ptr;
  1098.       eintragrec     = record
  1099.                          name:       filename;
  1100.                          nachfolger: eintrag_ptr
  1101.                        end;
  1102. const fsb_x          = 10;
  1103.       fsb_y          = 8;
  1104.       fsb_pro_zeile  = 4;
  1105.       fsb_zeilen     = 10;
  1106.       fsb_eintr      = fsb_pro_zeile*fsb_zeilen;
  1107. var startzeiger:       eintrag_ptr;
  1108.     fertig,abbruch,
  1109.     eintraege_vorh:    boolean;
  1110.     eintraege:         integer;
  1111.     rettscreen:        rettbildptr;
  1112.  
  1113. procedure eintraege_lesen;
  1114. var eintrag: searchrec;
  1115.  
  1116. procedure zur_liste(was: filename);
  1117. var zeiger:      eintrag_ptr_ad;
  1118.     hilfszeiger: eintrag_ptr;
  1119. begin
  1120.   zeiger:=@startzeiger;
  1121.   while (zeiger^<>nil) and (zeiger^^.name<was) do zeiger:=@zeiger^^.nachfolger;
  1122.   if zeiger^=nil
  1123.     then begin
  1124.       new(zeiger^);
  1125.       zeiger^^.nachfolger:=nil;
  1126.     end else begin
  1127.       hilfszeiger:=zeiger^;
  1128.       new(zeiger^);
  1129.       zeiger^^.nachfolger:=hilfszeiger;
  1130.     end;
  1131.   zeiger^^.name:=was;
  1132.   inc(eintraege);
  1133. end;   (* zur_liste *)
  1134.  
  1135. begin  (* eintraege_lesen *)
  1136.   eintraege:=0;
  1137.   findfirst(path+wildcard,archive,eintrag);
  1138.   while doserror=0 do begin
  1139.     zur_liste(eintrag.name);
  1140.     findnext(eintrag)
  1141.   end;
  1142.   findfirst(path+'*.*',archive+directory,eintrag);
  1143.   while doserror=0 do begin
  1144.     if ((eintrag.attr and directory)>0) and (eintrag.name<>'.') then
  1145.       zur_liste('['+eintrag.name+']');
  1146.     findnext(eintrag)
  1147.   end;
  1148.   eintraege_vorh:=startzeiger<>nil;
  1149.   if not eintraege_vorh then
  1150.     wrm(fsb_y+1,40,att[att_fsb_h],'Keine Einträge vorhanden!');
  1151. end;   (* eintraege_lesen *)
  1152.  
  1153. procedure auswaehlen;
  1154. var wahl,oben:      integer;
  1155.     taste:          char;
  1156.     changed,cursor: boolean;
  1157.     control:        control_typ;
  1158.     x,y:            byte;
  1159.  
  1160. function eintrag(nr: integer): eintrag_ptr;
  1161. var zeiger: eintrag_ptr;
  1162. begin
  1163.   zeiger:=startzeiger;
  1164.   while nr>0 do begin
  1165.     zeiger:=zeiger^.nachfolger;
  1166.     dec(nr);
  1167.   end;
  1168.   eintrag:=zeiger
  1169. end;  (* eintrag *)
  1170.  
  1171. procedure ausschnitt;
  1172.  
  1173. procedure darstellen;
  1174. var nr:     integer;
  1175.     zeiger: eintrag_ptr;
  1176.     lauf:   byte;
  1177. begin  (* darstellen *)
  1178.   for lauf:=fsb_y to fsb_y+fsb_zeilen-1 do
  1179.     wischen (lauf,fsb_x,fsb_pro_zeile*15,att[att_fsb_n]);
  1180.   zeiger:=eintrag(oben);
  1181.   nr:=0;
  1182.   while (nr<fsb_eintr) and (zeiger<>nil) do begin
  1183.     wr(fsb_y+(nr div fsb_pro_zeile),fsb_x+(nr mod fsb_pro_zeile)*15,
  1184.        att[att_fsb_n],zeiger^.name);
  1185.     zeiger:=zeiger^.nachfolger;
  1186.     inc(nr);
  1187.   end;
  1188. end;   (* darstellen *)
  1189.  
  1190. begin  (* ausschnitt *)
  1191.   if (wahl<oben) then begin
  1192.     oben:=(wahl div fsb_pro_zeile)*fsb_pro_zeile;
  1193.     darstellen;
  1194.   end else
  1195.     if (wahl>=oben+fsb_eintr) then begin
  1196.       oben:=((wahl div fsb_pro_zeile)*fsb_pro_zeile)-fsb_eintr+fsb_pro_zeile;
  1197.       darstellen;
  1198.     end;
  1199.   x:=fsb_x+(wahl mod fsb_pro_zeile)*15;
  1200.   y:=fsb_y+((wahl-oben) div fsb_pro_zeile);
  1201.   setattr(y,x,14,att[att_fsb_c]);
  1202. end;   (* ausschnitt *)
  1203.  
  1204. procedure suchen(wonach: string2);
  1205. var zeiger: eintrag_ptr;
  1206.     alt:    integer;
  1207. begin
  1208.   if startzeiger=nil then exit;
  1209.   alt:=wahl;
  1210.   zeiger:=eintrag(wahl);
  1211.   repeat
  1212.     inc(wahl);
  1213.     zeiger:=zeiger^.nachfolger;
  1214.     if zeiger=nil then begin
  1215.       zeiger:=startzeiger;
  1216.       wahl:=0
  1217.     end;
  1218.   until (wahl=alt) or
  1219.         (copy(zeiger^.name,1,length(wonach))=wonach)
  1220. end;   (* suchen *)
  1221.  
  1222. procedure laufwerk;
  1223. begin
  1224.   if diskfree(ord(taste))<>-1 then begin
  1225.     path:=chr(ord(taste)+64)+':';
  1226.     changed:=true
  1227.   end;
  1228. end;   (* laufwerk *)
  1229.  
  1230. procedure gewaehlt;
  1231. var zeiger: eintrag_ptr;
  1232. begin
  1233.   zeiger:=eintrag(wahl);
  1234.   if zeiger^.name[1]='[' then
  1235.     path:=path+copy(zeiger^.name,2,length(zeiger^.name)-2)+'\'
  1236.   else begin
  1237.     fileselect:=fexpand(path+zeiger^.name);
  1238.     fertig:=true
  1239.   end;
  1240. end;   (* gewaehlt *)
  1241.  
  1242. begin  (* auswaehlen *)
  1243.   changed:=false;
  1244.   wahl:=0;
  1245.   oben:=1;
  1246.   repeat
  1247.     if eintraege_vorh then ausschnitt;
  1248.     lies (control,taste,true);
  1249.     if eintraege_vorh then setattr(y,x,14,att[att_fsb_n]);
  1250.     case control of
  1251.       auf:  dec(wahl,fsb_pro_zeile);
  1252.       ab:   inc(wahl,fsb_pro_zeile);
  1253.       li:   dec(wahl);
  1254.       re:   inc(wahl);
  1255.       pos1: wahl:=0;
  1256.       end_: wahl:=eintraege;
  1257.       key:  case taste of
  1258.               'a'..'z': suchen(chr(ord(taste)-32));
  1259.               'A'..'Z': suchen('['+taste);
  1260.               '.',':':  suchen('[.');
  1261.               #1..#10:  laufwerk;
  1262.             end;
  1263.     end;
  1264.     if wahl<0 then wahl:=0;
  1265.     if wahl>=eintraege then wahl:=eintraege-1;
  1266.   until changed or (taste in [#27,#13]);
  1267.   if taste=#27 then abbruch:=true
  1268.                else if not changed then gewaehlt
  1269. end;   (* auswaehlen *)
  1270.  
  1271. procedure liste_loeschen;
  1272. var zeiger: eintrag_ptr;
  1273. begin
  1274.   zeiger:=startzeiger;
  1275.   while zeiger<>nil do begin
  1276.     dispose(zeiger); zeiger:=zeiger^.nachfolger;
  1277.   end;
  1278.   startzeiger:=nil;
  1279. end;   (* liste_loeschen *)
  1280.  
  1281. begin (* fileselect *)
  1282.   new(rettscreen,sichern);
  1283.   fileselect:=''; fertig:=false; abbruch:=false;
  1284.   repeat
  1285.     path:=fexpand(path); startzeiger:=nil;
  1286.     box(all_single_box,fsb_x-2,fsb_y-4,succ(fsb_pro_zeile*15),fsb_zeilen+3,
  1287.         att[att_fsb_r],att[att_fsb_n]);
  1288.     box(all_single_box,fsb_x-2,fsb_y-4,succ(fsb_pro_zeile*15),2,
  1289.         att[att_fsb_r],att[att_fsb_n]);
  1290.     wr(fsb_y-1,fsb_x-2,att[att_fsb_r],'├');
  1291.     wr(fsb_y-1,fsb_x+fsb_pro_zeile*15,att[att_fsb_r],'┤');
  1292.     wr(fsb_y-3,fsb_x,att[att_fsb_n],'Pfad: '+path+wildcard);
  1293.     wrm(fsb_y-2,fsb_x+((fsb_pro_zeile*15) div 2),att[att_fsb_n],
  1294.                                'CTRL + Laufwerksbuchstabe: Laufwerk ändern');
  1295.     eintraege_lesen;
  1296.     auswaehlen;
  1297.     liste_loeschen;
  1298.   until fertig or abbruch;
  1299.   dispose(rettscreen,wiederherstellen);
  1300. end;  (* fileselect *)
  1301.  
  1302.  
  1303. function Ja: boolean;
  1304. var Taste: char;
  1305. begin
  1306.   repeat
  1307.     Taste := Uppercase(ReadKey);
  1308.     if Taste = #0 then begin
  1309.       taste:=readkey;
  1310.       taste:=#0;
  1311.     end;
  1312.   until Taste in ['J','N'];
  1313.   ja:=taste='J'
  1314. end;
  1315.  
  1316.  
  1317. function Numerus(Zahl: longint; Einzahl, Endung: MaxString): MaxString;
  1318. begin
  1319.   if Zahl=1 then
  1320.     Numerus:=Strg(Zahl)+' '+Einzahl
  1321.   else
  1322.     if zahl=0 then
  1323.       numerus:='Keine '+einzahl+endung
  1324.     else
  1325.       Numerus:=Strg(Zahl)+' '+Einzahl+Endung
  1326. end;
  1327.  
  1328.  
  1329. function SgPl(Zahl: longint; Einzahl, Mehrzahl: MaxString): MaxString;
  1330. begin
  1331.   if Zahl=1 then
  1332.     SgPl:=Strg(Zahl)+' '+Einzahl
  1333.   else
  1334.     if zahl=0 then
  1335.       sgpl:='Keine '+mehrzahl
  1336.     else
  1337.       SgPl := Strg(Zahl) + ' ' + Mehrzahl
  1338. end;
  1339.  
  1340.  
  1341. function clog(von: real): real;
  1342. begin
  1343.   clog:=ln(von)/ln(10);
  1344. end;
  1345.  
  1346.  
  1347. function readkey: char;
  1348. var taste: char;
  1349. begin
  1350.   if nextchar<>#0
  1351.     then begin
  1352.       readkey:=nextchar;
  1353.       nextchar:=#0;
  1354.     end
  1355.     else begin
  1356.       repeat
  1357.         taste:=crt.readkey; rebuild:=false;
  1358.         if taste=#0
  1359.           then begin
  1360.             taste:=crt.readkey;
  1361.             if taste=hotkey
  1362.               then if specialfunx
  1363.                      then begin
  1364.                        readkey:=#0; nextchar:=rebuild_key; rebuild:=true;
  1365.                      end else taste:=#0
  1366.               else begin
  1367.                 nextchar:=taste; readkey:=#0
  1368.               end;
  1369.           end
  1370.           else readkey:=taste
  1371.       until taste<>#0
  1372.     end;
  1373. end;
  1374.  
  1375.  
  1376. begin
  1377.   parameter_auswerten;
  1378.   grafik_init;
  1379.   setcbreak(false); checkbreak:=false;
  1380.   randomize; assign(i,'KAISER.NAM');
  1381.   savepath:=''; nextchar:=#0; spec_funx_aktiv:=false;
  1382.   load_config;
  1383. end.