'
' GDOS/VDI-Routinen f�r GFA-BASIC 3.x
'
' von Gregor Duchalski, Baueracker 15a, 4690 Herne 1
' eMail: GREGOR DUCHALSKI @ DO im MausNet
'
' last change 10.09.92
' ------------------------------------------------------------------------------
' Das GFA-BASIC unterst�tzt leider neuere GDOS-Versionen wie AMC-GDOS oder FSM-
' GDOS nicht korrekt, gerade bei der Druckerausgabe kommt es zu Abst�rzen. Daher
' ersetzen wir diese Routinen durch Eigenimplementation der VDI-Funktionen.
' Das bringt weitere Vorteile, wie die Umgehung des ungenauen DEFTEXT-Befehles.
'
' Diese Routinen wurden zum ersten Mal in der Zeitschrift ST COMPUTER, Ausgabe
' 3/92, Seite 80, 'Druckeransteuerung via GDOS', vorgestellt. Dieser Text befin-
' det sich unter dem Namen 'GDOS.TXT' ebenfalls im Lieferumfang.
' N„heres entnehmen Sie bitte entsprechender Fachliteratur (Profibuch).
'
' Das vorliegende Listing dient als Beispiel f�r die GDOS-Ansteuerung. Aužerdem
' enth„lt es weitere VDI-Funktionen, die aber vom Programm selbst nicht ben”tigt
' werden.
'
' Bitte vor dem Start den INLINE in 'vq_vgdos' einlesen!
' ------------------------------------------------------------------------------
'
gdos_init
screen_fonts
drucker_fonts
'
gdos_exit
'
> PROCEDURE gdos_init
  '
  ' Der RESERVE-Wert MUž durch 256 sein!
  fre%=1560*256
  '
  ' Kein Gdos vorhanden
  IF GDOS?=FALSE
    PRINT "Kein GDOS..."
    END
  ENDIF
  '
  ' Kein Drucker vorhanden
  IF OUT?(0)=FALSE
    PRINT "Kein Drucker..."
    END
  ENDIF
  '
  ' Speicher reservieren
  RESERVE FRE(0)-fre%
  '
RETURN
> PROCEDURE gdos_exit
  '
  ' Falls �berhaupt ge”ffnet...
  IF handle&>0
    '
    ' Druckerfonts entfernen
    ~@vst_unload_fonts(handle&,0)
    '
    ' Drucker-Workstation schliežen
    ~@v_clswk(handle&)
    '
  ENDIF
  '
  ' Bildschirmfonts entfernen
  ~@vst_unload_fonts(V~H,0)
  '
  ' Speicher restaurieren
  RESERVE FRE(0)+fre%
  '
  END
  '
RETURN
'
> PROCEDURE screen_fonts
  '
  ' Felder f�r Index, Name und Gr”žen
  DIM s_fnt&(10),s_fnt$(10),s_point$(10)
  '
  ' Fonts laden
  s_anz&=SUCC(VST_LOAD_FONTS(0))
  '
  FOR i&=1 TO s_anz&
    '
    ' Fontindex
    s_fnt&(i&)=VQT_NAME(i&,a$)
    '
    ' Fontname
    s_fnt$(i&)=a$
    '
  NEXT i&
  '
  ' Pointgr”žen in s_point$() eintragen
  point_groessen(V~H,s_anz&,s_fnt&(),s_point$())
  '
  CLS
  PRINT "Verf�gbare Bildschirmfonts:"
  '
  fonts_anzeigen(s_anz&,s_fnt$(),s_point$())
  '
  IF a|=27            !ESC=>Abbruch
    gdos_exit
  ENDIF
  '
  fonts_ausgeben(V~H) !Bildschirmausgabe
  '
  KEYGET a|           !Tastendruck
  '
RETURN
> PROCEDURE drucker_fonts
  '
  ' Felder f�r Index, Name und Gr”žen
  DIM p_fnt&(10),p_fnt$(10),p_point$(10)
  '
  ' Drucker-Workstation ”ffnen. Der ein-
  ' zige GFA-GDOS-Befehl, den wir zur
  ' Druckeransteurung noch verwenden.
  handle&=V_OPNWK(21)
  '
  ' Fehler bei V_OPNWK()
  IF handle&<=0
    PRINT "Fehler bei V_OPNWK(21)..."
    gdos_exit
  ENDIF
  '
  ' Fonts laden
  p_anz&=SUCC(@vst_load_fonts(handle&,0))
  '
  FOR i&=1 TO p_anz&
    '
    ' Fontindex
    p_fnt&(i&)=@vqt_name(handle&,i&,a$,fsm_flag&)
    '
    ' Ist fsm_flag&<>0, dann ist der Font freiskalierbar
    '
    ' Fontname
    p_fnt$(i&)=a$
    '
  NEXT i&
  '
  ' Pointgr”žen in p_point$() eintragen
  point_groessen(handle&,p_anz&,p_fnt&(),p_point$())
  '
  CLS
  PRINT "Verf�gbare Druckerfonts:"
  '
  fonts_anzeigen(p_anz&,p_fnt$(),p_point$())
  '
  IF a|<>27  ! ESC=>Abbruch
    '
    ' Druckerausgabe, zun„chst auf
    ' einen internen Puffer
    fonts_ausgeben(handle&)
    '
    ' Seite drucken
    ~@v_updwk(handle&)
    '
  ENDIF
  '
RETURN
' -------------------------------------------------------- SCREEN & PRINTER
> PROCEDURE point_groessen(handle&,anz&,VAR a&(),a$())
  LOCAL i&,a&,b&,c&
  '
  ' Hier werde f�r jeden Font die ver-
  ' baren Pointgr”žen ermittelt und in
  ' s_point$() f�r den Bildschirm und
  ' p_point$() f�r den Drucker
  ' eingetragen...
  '
  ' Alle Fonts durchgehen
  FOR i&=1 TO anz&
    '
    ' Font einstellen
    a&=@vst_font(handle&,a&(i&))
    '
    a&=999
    b&=a&
    '
    WHILE a&>1
      '
      c&=b&
      '
      ' Neue Gr”že setzen
      b&=@vst_point(handle&,a&,a&,a&,a&,a&)
      '
      ' Keine neue H”he, also Schluž
      EXIT IF c&=b&
      '
      ' N„chste Pointh”he eintragen
      a$(i&)=a$(i&)+CHR$(b&)
      '
      a&=PRED(b&)
      '
    WEND
    '
  NEXT i&
  '
RETURN
> PROCEDURE fonts_anzeigen(anz&,VAR a$(),b$())
  LOCAL i&,t&
  '
  ' Diese Prozedur zeigt an, welche
  ' Fonts geladen wurden und welche
  ' Pointh”hen verf�gbar sind...
  '
  PRINT AT(40,1);"Pointgr”žen:"
  '
  FOR i&=1 TO anz&
    '
    PRINT AT(1,i&+2);a$(i&);AT(40,i&+2);
    '
    FOR t&=1 TO LEN(b$(i&))
      PRINT ",";ASC(MID$(b$(i&),t&,1));
    NEXT t&
    PRINT
    '
  NEXT i&
  '
  PRINT
  PRINT "Taste dr�cken, ESC zum Abbruch..."
  '
  KEYGET a|           ! Tastendruck
  '
RETURN
> PROCEDURE fonts_ausgeben(handle&)
  '
  ' Zuerst Font 2, 10 points hoch...
  ~@vst_font(handle&,s_fnt&(2))
  ~@vst_point(handle&,10,a&,a&,a&,a&)
  text(10,160,s_fnt$(2)+" in 10 Points...")
  '
  ' Font 2, 12 points hoch...
  ~@vst_point(handle&,12,a&,a&,a&,a&)
  text(10,220,s_fnt$(2)+" in 12 Points...")
  '
  ' Font 3, wieder 10 points
  ~@vst_font(handle&,s_fnt&(3))
  ~@vst_point(handle&,10,a&,a&,a&,a&)
  text(10,280,s_fnt$(3)+" in 10 Points...")
  '
RETURN
' -------------------------------------------------------- VDI-Bindings
> FUNCTION vq_vgdos
$F%
LOCAL a%
'
' Ermittelt, ob und welches GDOS vorhanden ist und gibt eine
' entsprechende Kennung zur�ck...
'
' Hier die Datei 'VQ_VGDOS.INL' einladen:
INLINE vq_vgdos_asm%,10
'
a%=C:vq_vgdos_asm%()     ! TRAP #2 Aufruf
'
IF WORD(a%)=-2           ! D0 unver„ndert...
  RETURN 0               ! ...kein GDOS
  '
ELSE IF MKL$(a%)="_FSM"  ! D0="_FSM"...
  RETURN a%              ! ...FSMGDOS installed
  '
ELSE IF MKL$(a%)="_FNT"  ! D0="_FNT"...
  RETURN a%              ! ...FONT-GDOS installed
  '
ENDIF
'
RETURN CVL("GDOS")       ! ...sonst normales GDOS
ENDFUNC
'
> FUNCTION v_updwk(handle&)
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 4,0,0
'
RETURN 0            ! Void
ENDFUNC
> FUNCTION v_clswk(handle&)
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 2,0,0
'
RETURN 0            ! Void
ENDFUNC
> FUNCTION v_clrwk(handle&)
$F%
'
CONTRL(6)=handle&
'
VDISYS 3,0,0
'
RETURN 0
ENDFUNC
'
> FUNCTION vst_load_fonts(handle&,a&)
'
INTIN(0)=a&         ! Reserviert, 0
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 119,1,0
'
RETURN INTOUT(0)    ! Anzahl Fonts
ENDFUNC
> FUNCTION vst_unload_fonts(handle&,a&)
'
INTIN(0)=a&         ! Reserviert, 0
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 120,1,0
'
RETURN 0            ! Void
ENDFUNC
> FUNCTION vqt_name(handle&,nr&,VAR a$,i&)
$F%
LOCAL a%,a|
'
' Diese Routinen gibt in i& einen Wert <>0 zur�ck, wenn der Fonts
' freiskalierbar ist (FSM-GDOS).
'
a$=SPACE$(32)
a%=V:a$
'
INTIN(0)=nr&
'
CONTRL(6)=handle&
'
VDISYS 130,1,0
'
FOR i&=1 TO 32
'
a|=INTOUT(i&)
EXIT IF a|=0
'
BYTE{a%}=a|
INC a%
'
NEXT i&
'
i&=INTOUT(33)
a$=TRIM$(a$)
'
RETURN INTOUT(0)
ENDFUNC
'
> FUNCTION vst_font(handle&,nr&)
'
' Entspricht DEFTEXT ,,,,x
'
INTIN(0)=nr&        ! Font-Index
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 21,1,0
'
RETURN INTOUT(0)    ! Gesetzter Font
ENDFUNC
> FUNCTION vst_point(handle&,h&,VAR a&,b&,c&,d&)
'
INTIN(0)=h&         ! Pointh”he
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 107,1,0
'
a&=PTSOUT(0)        ! Zeichenbreite
b&=PTSOUT(1)        ! Zeichenh”he
c&=PTSOUT(2)        ! Zellenbreite
d&=PTSOUT(3)        ! Zellenh”he
'
RETURN INTOUT(0)    ! Gesetzte H”he
ENDFUNC
> FUNCTION v_justified(handle&,x&,y&,l&,w&,z&,a$)
'
' TEXT
'
PTSIN(0)=x&         ! x-Position
PTSIN(1)=y&         ! y-Position
'
PTSIN(2)=l&         ! Textl„nge
PTSIN(3)=0          ! reserviert
'
' Die beiden n„chsten Parameter legen
' f�r Wort- und Zeichenzwischenr„ume
' getrennt fest,ob eine Dehnung statt-
' finden soll (>0) oder nicht (=0).
' Beim GFA-Befehl TEXT sind diese An-
' gaben und die Textl„nge (PTSIN(2))
' im 3.Parameter zusammengefasst.
'
INTIN(0)=w&         ! Wortzwischenraum
INTIN(1)=z&         ! Zeichenzwischenraum
'
l&=LEN(a$)          ! Stringl„nge
'
FOR i&=1 TO l&      ! String
INTIN(SUCC(i&))=ASC(MID$(a$,i&))
NEXT i&
'
CONTRL(6)=handle&   ! Ger„tehandle
'
VDISYS 11,ADD(l&,2),2,10
'
RETURN 0            ! Void
ENDFUNC
'
> PROCEDURE text(x&,y&,a$)
'
' ------------------------------------
' Diese Prozedur dient nur der
' Vereinfachung des TEXT-Aufrufes.
' Die Ausrichtung des Textes �ber die
' Dehnung der Wort-oder Zeichenabst„n-
' de wird hier nicht ber�cksichtigt.
'
~@v_justified(handle&,x&,y&,0,0,0,a$)
'
RETURN
' -------------------------------------------------------- Weitere VDI-Bindings
> PROCEDURE vswr_mode(handle&,a&)
'
' Entpricht GRAPHMODE
'
INTIN(0)=a&
CONTRL(6)=handle&
'
VDISYS 32,1,0
'
RETURN
> PROCEDURE vqt_extent(handle&,a$,VAR a&,b&,c&,d&,e&,f&,g&,h&)
LOCAL i&,l&
'
' a$=a$+CHR$(0)
'
l&=LEN(a$)
'
FOR i&=1 TO l&
INTIN(PRED(i&))=ASC(MID$(a$,i&,1))
NEXT i&
'
CONTRL(6)=handle&
'
VDISYS 116,l&,0
'
a&=PTSOUT(0)
b&=PTSOUT(1)
c&=PTSOUT(2)
d&=PTSOUT(3)
e&=PTSOUT(4)
f&=PTSOUT(5)
g&=PTSOUT(6)
h&=PTSOUT(7)
'
RETURN
> FUNCTION vst_alignment(handle&,a&,b&)
$F%
'
INTIN(0)=a&        !x-Beginn setzen 0-2
INTIN(1)=b&        !y_Beginn setzen 0-7
'
CONTRL(6)=handle&
'
VDISYS 39,2,0
'
RETURN 0
ENDFUNC
> FUNCTION vs_clip(handle&,a&,x&,y&,w&,h&)
'
' Entspricht CLIP
'
INTIN(0)=a&
'
PTSIN(0)=x&
PTSIN(1)=y&
PTSIN(2)=ADD(x&,PRED(w&))
PTSIN(3)=ADD(y&,PRED(h&))
'
CONTRL(6)=handle&
'
VDISYS 129,1,2
'
RETURN 0
ENDFUNC
> PROCEDURE v_bit_image(handle&,a$,a&,b&,c&,d&,e&,x&,y&,w&,h&)
LOCAL i&,j&
'
' Gibt eine IMG-Datei auf der Workstation aus.
'
CONTRL(6)=handle&
'
INTIN(0)=a&
INTIN(1)=b&
INTIN(2)=c&
INTIN(3)=d&
INTIN(4)=e&
'
j&=4
FOR i&=0 TO PRED(LEN(a$))
'
INC j&
INTIN(j&)=BYTE{ADD(V:a$,i&)}
'
NEXT i&
'
INC j&
'
PTSIN(0)=x&
PTSIN(1)=y&
PTSIN(2)=ADD(x&,PRED(w&))
PTSIN(3)=ADD(y&,PRED(h&))
'
VDISYS 5,j&,2,23
'
RETURN