home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / VIDEOTEXT.LZX / VTsrc / sys2.p < prev    next >
Encoding:
Text File  |  1996-02-04  |  8.9 KB  |  269 lines
  1. UNIT sys2; {$project vt}
  2. { abgespeckte Version vom UNIT sys, für VTview }
  3.  
  4. INTERFACE;
  5.  
  6. TYPE Str80 = String[80];
  7.  
  8. VAR taste: Char;
  9.     escseq: String[10];
  10.     newevent,mouseclicked,dblclicked,menupicked,slidermoved: Boolean;
  11.     clickedx,clickedy: Integer;
  12.     menucode: Long;
  13.     sliderposn: Real; { 0..1 }
  14.     colperm: Long;
  15.     Con: Ptr;  { darf nicht vom ExitServer geschlossen werden, komisch }
  16.  
  17. PROCEDURE event_scan;
  18. PROCEDURE update_slider(i, anz: Integer);
  19. FUNCTION fileselect(was_los: str80; speichern: Boolean;
  20.                                    VAR selected: str80): Boolean;
  21. PROCEDURE desaster(meldung: Str80);
  22. PROCEDURE stretch_line(zeile, sp0, sp1: Integer);
  23. PROCEDURE raster_line(zeile, sp0, sp1: Integer; farbe: Word);
  24. PROCEDURE sysinit(version: Str);
  25. PROCEDURE sysclean;
  26.  
  27. { ---------------------------------------------------------------------- }
  28.  
  29. IMPLEMENTATION;
  30.  
  31. {$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
  32. {$incl "intuition.lib", "graphics.lib" }
  33. {$incl "diskfont.lib", "dos.lib", "icon.lib", "asl.lib","exec.lib" }
  34.  
  35. VAR NeuerScreen: ExtNewScreen;  STATIC;
  36.     MyScreen: p_Screen;
  37.     Tags: Array[1..10] OF TagItem;  STATIC;
  38.     titel: Str80;  STATIC;
  39.     NeuesWindow: NewWindow;  STATIC;
  40.     MyWindow: p_Window;
  41.     Schieber: Gadget;
  42.     SchieberInfo: PropInfo;
  43.     MoverData: Image; STATIC;
  44.     Strip, LastMenu: p_Menu;
  45.     LastItem, LastSubItem: p_MenuItem;
  46.     nextselect: Word;
  47.     lastevent: IntuiMessage; { kein Zeiger! }
  48.     topazAttr,teleAttr: TextAttr;
  49.     teleFont: p_TextFont;
  50.  
  51. PROCEDURE event_scan;
  52. { überträgt eingehende Tasten und ESC-Sequenzen sowie die Intuition- }
  53. { Ereignisse Mausklick und Menuewahl in globale Variablen. }
  54. VAR Msg: ^IntuiMessage;
  55.     gad: ^Gadget;
  56.     propi: ^PropInfo;
  57.     i,charx,chary: Integer;
  58. PROCEDURE menu_eval(item: Word);
  59. { wird an zwei Stellen gebraucht ... }
  60. VAR men,menitem,subitem: Word;
  61.     item_address: ^MenuItem;
  62. BEGIN
  63.   newevent := True; menupicked := True;
  64.   { Menue, Menuepunkt und Untermenue ermitteln und diese in ziemlich }
  65.   { mutierter Form wieder gemeinsam in einem Langwort ablegen: }
  66.   men := item AND $1F;
  67.   menitem := (item SHR 5) AND $3F;
  68.   subitem := (item SHR 11) AND $1F;
  69.   menucode := (Long(men+1) SHL 16) OR ((menitem+1) SHL 8) OR (subitem+1);
  70.   item_address := ItemAddress(Strip,item);
  71.   nextselect := item_address^.NextSelect;
  72. END;
  73. BEGIN
  74.   IF nextselect<>MENUNULL THEN BEGIN
  75.     menu_eval(nextselect); Exit;
  76.   END
  77.   taste := ReadCon(Con);
  78.   IF taste<>#0 THEN BEGIN
  79.     newevent := True; i := 0;
  80.     IF taste=#155 THEN REPEAT
  81.       Inc(i); escseq[i] := ReadCon(Con);
  82.     UNTIL (escseq[i]>='@') OR (i=9);
  83.     escseq[i+1] := #0;
  84.     Exit;
  85.   END;
  86.   Msg := Get_Msg(MyWindow^.UserPort);
  87.   IF Msg<>Nil THEN BEGIN
  88.     CASE Msg^.class OF
  89.       MENUPICK: IF Msg^.Code<>MENUNULL THEN menu_eval(Msg^.Code);
  90.       MOUSEBUTTONS: IF Msg^.code=SELECTDOWN THEN BEGIN
  91.           newevent := True; mouseclicked := True;
  92.           charx := MyWindow^.RPort^.TxWidth;
  93.           chary := MyWindow^.RPort^.TxHeight;
  94.           clickedx := 1 + (Msg^.MouseX - MyWindow^.BorderLeft) DIV charx;
  95.           clickedy := 1 + (Msg^.MouseY - MyWindow^.BorderTop) DIV chary;
  96.           dblclicked := DoubleClick(lastevent.seconds,lastevent.micros,
  97.               Msg^.seconds,Msg^.micros);
  98.           lastevent := Msg^;
  99.         END;
  100.       GADGETUP: BEGIN
  101.           gad := Msg^.IAddress;
  102.           IF gad=^Schieber THEN BEGIN
  103.             slidermoved := True; newevent := True;
  104.             propi := gad^.SpecialInfo;
  105.             sliderposn := Real(propi^.HorizPot)/MAXPOT;
  106.           END;
  107.         END;
  108.       OTHERWISE;
  109.     END;
  110.     Reply_Msg(Msg);
  111.   END;
  112. END;
  113.  
  114. PROCEDURE update_slider{(i, anz: Integer)};
  115. { PropGadget auf Position i von (0..anz-1) stellen }
  116. VAR max: Integer;
  117. BEGIN
  118.   IF anz=0 THEN anz := 1;
  119.   max := anz-1; IF max=0 THEN max := 1;
  120.   NewModifyProp(^Schieber,MyWindow,Nil,FREEHORIZ OR AUTOKNOB,
  121.       MAXPOT DIV max*i, 0, MAXBODY DIV anz, MAXBODY, 1);
  122. END;
  123.  
  124. FUNCTION fileselect{(was_los: str80; speichern: Boolean;
  125.                                    VAR selected: str80): Boolean};
  126. { Mit Filerequester der asl.library, sofern vorhanden, sonst gar nicht. }
  127. VAR i,p,l: Integer;
  128.     Req: p_FileRequester;
  129.     Msg: p_IntuiMessage;
  130.     pfad,name: str80;
  131. BEGIN
  132.   fileselect := False;
  133.   AslBase := OpenLibrary(ASLNAME,0);
  134.   IF AslBase=Nil THEN Exit;
  135.   l := Length(selected);
  136.   { selected in pfad und name spalten }
  137.   p := 0; FOR i := 1 TO l DO
  138.     IF selected[i] IN ['/',':'] THEN p := i;
  139.   IF p=0 THEN pfad := '' ELSE pfad := Copy(selected,1,p);
  140.   IF p=l THEN name := '' ELSE name := Copy(selected,p+1,l-p);
  141.   Tags[1] := TagItem(ASL_Hail,Long(^was_los));
  142.   Tags[2] := TagItem(ASL_Dir,Long(^pfad));
  143.   Tags[3] := TagItem(ASL_File,Long(^name));
  144.   Tags[4] := TagItem(ASL_FuncFlags,FILF_SAVE);
  145.   IF speichern THEN Tags[5] := TagItem(TAG_DONE,0)
  146.     ELSE Tags[4] := TagItem(TAG_DONE,0);
  147.   Req := AllocAslRequest(ASL_FileRequest,^Tags);
  148.   IF Req<>NIL THEN BEGIN
  149.     IF RequestFile(Req) THEN
  150.       IF Req^.rf_File<>'' THEN BEGIN
  151.         fileselect := True;
  152.         pfad := Req^.rf_Dir; l := Length(pfad);
  153.         name := Req^.rf_File;
  154.         IF l=0 THEN
  155.           selected := name
  156.         ELSE IF pfad[l] IN [':','/'] THEN
  157.           selected := pfad+name
  158.         ELSE
  159.           selected := pfad+'/'+name;
  160.       END;
  161.     FreeAslRequest(Req);
  162.   END;
  163.   IF AslBase<>Nil THEN CloseLibrary(AslBase);
  164.   AslBase := Nil;
  165. END;
  166.     
  167. { PROCEDURE's desaster(), raster_line(), stretch_line() sowie die }
  168. { Menü-Erzeugung includen: }
  169. CONST unit_sys=1701; {$path "PAS:prg/vt/"; incl "dbluse.p" }
  170.  
  171. PROCEDURE create_menu;
  172. CONST Check = CHECKIT OR MENUTOGGLE;
  173.       CheckOn = Check OR CHECKED;
  174. VAR egal: Boolean;
  175. BEGIN
  176.   LastMenu := Nil;
  177.   AddMenu(10, 'VTview');
  178.   { AddItem(0, 0, 'Datei lesen',  'L');
  179.     AddItem(0, 0, 'Seite drucken','P'); }
  180.     AddItem(0, 0, 'Ende',         'Q');
  181.   MenuWidths;
  182.   egal := SetMenuStrip(MyWindow,Strip);
  183. END;
  184.  
  185. PROCEDURE sysinit{(version: Str)};
  186. VAR i,j,breite,hoehe: Integer;
  187.     l: Long;
  188. BEGIN
  189.   titel := Copy(version,7,Length(version)-6);
  190.   { Zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  191.   IntuitionBase := Nil; GfxBase := Nil; DiskFontBase := Nil; AslBase := Nil;
  192.   MyScreen := Nil; MyWindow := Nil; teleFont := Nil;
  193.   { Libraries etc. öffnen: }
  194.   IntuitionBase := OpenLibrary('intuition.library',0);
  195.   GfxBase := OpenLibrary(GRAPHICSNAME,0);
  196.   DiskFontBase := OpenLibrary('diskfont.library',0);
  197.   IF IntuitionBase=Nil THEN Error('Can''t open intuition.library!');
  198.   IF GfxBase=Nil THEN Error('Can''t open graphics.library!');
  199.   IF DiskfontBase=Nil THEN desaster('Can''t open diskfont.library !!!');
  200.   { Screen: }
  201.   breite := 320; hoehe := 256;
  202.   topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  203.   i := -1;  { Default-DrawInfo-Pens für 2.0 }
  204.   Tags[1] := TagItem(SA_Pens,Long(^i));
  205.   Tags[2] := TagItem(TAG_DONE,0);
  206.   NeuerScreen := ExtNewScreen(0,0,breite,hoehe,3, 0,1, 0,
  207.        NS_EXTENDED OR CUSTOMSCREEN,^topazAttr,titel,Nil,Nil,Nil);
  208.   MyScreen := OpenScreen(^NeuerScreen);
  209.   IF MyScreen=Nil THEN Error('Can''t open screen!');
  210.   FOR i := 0 TO 7 DO
  211.     SetRGB4(^MyScreen^.ViewPort, (colperm SHR (4*(7-i))) AND $F,
  212.         15*(i AND 1), 15*((i DIV 2) AND 1),15*((i DIV 4) AND 1));
  213.   { Fenster und Menue: }
  214.   NeuesWindow := NewWindow(0,16,breite,hoehe-16, 0,1,
  215.         MENUPICK OR MOUSEBUTTONS OR GADGETUP, ACTIVATE OR BORDERLESS,
  216.         Nil,Nil,Nil,MyScreen,Nil,170,100,breite,hoehe,CUSTOMSCREEN);
  217.   MyWindow := OpenWindow(^NeuesWindow);
  218.   IF MyWindow=Nil THEN Error('Can''t open window!');
  219.   create_menu;
  220.   { Propgadget: }
  221.   Schieber:=Gadget(Nil,0,-12,0,12,GADGHCOMP OR GRELWIDTH OR GRELBOTTOM,
  222.       BOTTOMBORDER OR RELVERIFY,PROPGADGET,^Moverdata,Nil,
  223.                    Nil,0,^Schieberinfo,2,Nil);
  224.   SchieberInfo:=Propinfo(FREEHORIZ or AUTOKNOB,$8000,$8000,$8000 div 5,0,
  225.                          0,0,0,0,0,0);
  226.   l := AddGadget(MyWindow,^Schieber,0);
  227.   { Font: }
  228.   teleAttr := TextAttr('videotext.font',9,FS_NORMAL,FPF_DISKFONT);
  229.   IF DiskFontBase<>Nil THEN
  230.     teleFont := OpenDiskFont(^teleAttr);
  231.   IF teleFont<>Nil THEN
  232.     l := SetFont(MyWindow^.RPort,teleFont)
  233.   ELSE
  234.     desaster('Can''t open videotext.font !!!');
  235.   { Console einrichten: }
  236.   Con := OpenConsole(MyWindow);
  237.   SetStdIO(Con);
  238.   RefreshGadgets(^Schieber,MyWindow,Nil);
  239. END;
  240.  
  241. PROCEDURE sysclean;
  242. VAR l: Long;
  243. BEGIN
  244.   IF MyWindow<>Nil THEN BEGIN
  245.     l := RemoveGadget(MyWindow,^Schieber);
  246.     IF Strip<>Nil THEN ClearMenuStrip(MyWindow); TrashMenu;
  247.     CloseWindow(MyWindow);
  248.   END;
  249.   IF MyScreen<>Nil THEN IF CloseScreen(MyScreen) THEN;
  250.   IF teleFont<>Nil THEN CloseFont(teleFont);
  251.   IF IntuitionBase<>Nil THEN CloseLibrary(IntuitionBase);
  252.   IF GfxBase<>Nil THEN CloseLibrary(GfxBase);
  253.   IF DiskFontBase<>Nil THEN CloseLibrary(DiskFontBase);
  254.   { festhalten, daß alles geschlossen ist: }
  255.   MyWindow := Nil; Strip := Nil;
  256.   MyScreen := Nil;
  257.   teleFont := Nil;
  258.   IntuitionBase := Nil;
  259.   GfxBase := Nil;
  260.   DiskFontBase := Nil;
  261. END;
  262.  
  263. BEGIN  { Initialisierungsteil }
  264.   colperm := $01234567;
  265.   newevent := False; lastevent.seconds := 0; nextselect := MENUNULL;
  266.   mouseclicked := False; menupicked := False; slidermoved := False;
  267. END.
  268.  
  269.