DataMuseum.dk

top - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »SKRIVGR.PAS«

└─⟦6cf793dfc⟧ Bits:30003506 JET80 Grafik og fontprogrammering
    └─ ⟦this⟧ »SKRIVGR.PAS« 

TextFile

PROGRAM skrivgr_rnt;

CONST    rnt_ant             = 16;

TYPE     str8                = String(.8.);

VAR      error               : Boolean;
         t                   : Char;
         fil                 : Array(.1..rnt_ant.) OF String(.8.);
         br,ho,fnr,i         : Byte;
         x,y                 : Integer;

(*$I minigr *)

PROCEDURE init;
BEGIN
  fil(.1.):='ASCII12';
  fil(.2.):='CIRCUS24';
  fil(.3.):='COPR18';
  fil(.4.):='COPR24';
  fil(.5.):='FEANOR18';
  fil(.6.):='GOTH18';
  fil(.7.):='GOTH24';
  fil(.8.):='GOTHB18';
  fil(.9.):='GOTHB24';
  fil(.10.):='ITALIC18';
  fil(.11.):='ITALIC24';
  fil(.12.):='PUNC18';
  fil(.13.):='PUNC24';
  fil(.14.):='ROMAN18';
  fil(.15.):='ROMAN24';
  fil(.16.):='SROMAN24';
END;


PROCEDURE skriv(tkn:Char;dot_size:Byte;rontfil:str8;VAR odef:Boolean;
                VAR matb,math:Byte);

TYPE     rnt_typ             = (init,norm);
         tkn_rec             = RECORD
                                 CASE rnt_typ OF
                                   init : (init:RECORD
                                                  height,intra_chr,
                                                  intra_ln   : Byte;
                                                END;);
                                   norm : (norm: RECORD
                                                   aktiv : Boolean;
                                                   bredd : Byte;
                                                   rad   : Array(.1..3,
                                                           1..50.) OF Byte;
                                                 END;);
                               END;

VAR      h,pek,ant,kom,i,hght,
         inch,inln           : Byte;
         rntfil              : File OF tkn_rec;
         rnt_rec             : tkn_rec;



BEGIN
  Assign(rntfil,rontfil+'.RNT');
  Reset(rntfil);
  Read(rntfil,rnt_rec);
  hght:=rnt_rec.init.height;
  inch:=rnt_rec.init.intra_chr;
  inln:=rnt_rec.init.intra_ln;
  IF (Ord(tkn)-31)<FileSize(rntfil) THEN
  BEGIN
    Seek(rntfil,(Ord(tkn)-31));
    Read(rntfil,rnt_rec);
    WITH rnt_rec.norm DO
      IF aktiv THEN
      BEGIN
        odef:=False;
        FOR pek:=1 TO bredd DO
          Write(#37,Chr(rad(.1,pek.)),Chr(rad(.2,pek.)),
                #$C0,#0,#$D0,#$0F,#37,Chr(rad(.3,pek.)),#0,
                #$C0,#0,#$D0,#$08,#$C9,#$17);
        Write(#37,#$FF,#$FF,#$C8,Chr(inch SHL 4));
        matb:=bredd+inch;
        math:=hght*6+inln;
      END
      ELSE
        odef:=True;
  END
  ELSE
    odef:=True;
END;


BEGIN
  init;
  REPEAT
    ClrScr;
    Writeln('                   Dessa fonter finns : ',#10);
    FOR fnr:=1 TO rnt_ant DO
      Writeln('                  ',fnr:2,'   -   ',fil(.fnr.));
    Write(#10,'                  Ge ett nr (0 før att sluta) - ');
    REPEAT
      Read(fnr);
    UNTIL (fnr>=0) AND (fnr<=rnt_ant);
    ClrScr;
    IF fnr<>0 THEN
    BEGIN
      cl_graf;
      x:=50;
      y:=399;
      GotoXY(60,23);
      Write('Tryck något !');
      GotoXY(60,24);
      Write('(Space bryter)');
      enter_graphics;
      abs_move(50,399,False);
      REPEAT
        Read(KBD,t);
        IF t IN (.#33..'ü'.) THEN
        BEGIN
          skriv(t,1,fil(.fnr.),error,br,ho);
          IF error THEN Write(#7,#27,#81);
          x:=x+br;
          IF x>580 THEN
          BEGIN
            x:=50;
            y:=y-ho;
            IF y<30 THEN
            BEGIN
              y:=0;
              cl_graf;
            END;
            abs_move(x,y,False);
          END;
        END;
      UNTIL t=#32;
      cl_graf;
    END;
  UNTIL fnr=0;
END.
«eof»