DataMuseum.dk

top - metrics - download

    Length: 5888 (0x1700)
    Types: TextFile
    Names: »TEGN007.PAS«

└─⟦29e35ddf2⟧ Bits:30003931/CCPM_Tegn.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »TEGN007.PAS« 

TextFile

(* Procedures for initialization and use of the
   TELEDATA characterset 
*)   

TYPE
 NAME       = STRINGÆ20Å;
 DWSTR      = STRINGÆ2Å;
 DHSTR      = STRINGÆ9Å;
 DWARRAY    = ARRAYÆ0..127Å OF DWSTR;
 DHARRAY    = ARRAYÆ0..127Å OF DHSTR;
  
FUNCTION init_double_char(file_name: NAME; 
                          VAR dwa: DWARRAY;
                          VAR dha: DHARRAY): INTEGER;

 (* The function reads a TELEDATA character-file,
    and initializes the alternative charactersets *)
      
 TYPE
  FONTTYPE = ARRAYÆ0..14Å OF INTEGER;

 VAR
  tdchar_file  : FILE;
  font         : FONTTYPE;
  i, n, index  : INTEGER;
  result       : INTEGER;
  buffer       : ARRAYÆ1..64Å OF INTEGER;

 FUNCTION read_word: INTEGER;
  VAR
   c_count: INTEGER;
  BEGIN (* get next word from teledata char-file *)
   IF index = 64 THEN
    BEGIN (* buffer empty *)
     blockread(tdchar_file, buffer, 1, c_count);
     index := 1;
    END
   ELSE index := index + 1;
    read_word := bufferÆindexÅ;
  END; (*read_word *)

 FUNCTION rch: CHAR;
 BEGIN
  rch := CHAR(read_word - 256);
 END;
  
 PROCEDURE define_alt_font(font: FONTTYPE);
  CONST
   xios        = $28;
   define_font = 52 ;
  VAR
   reg: RECORD ax,bx,cx,dx,bp,si,di,ds,es,flags: INTEGER; END;
   i, mask, ones : INTEGER;
  BEGIN
   reg.ax := define_font; (* xios function no *)
   reg.cx := 512 + fontÆ0Å;
   reg.dx := ofs(fontÆ1Å);
   reg.ds := seg(fontÆ1Å);
   swint(xios, reg); (* call xios extra function: define_font *)
  END; (* define_alt_font *)

 BEGIN (* Body of "init_double_char" *)
  (*$I-*)
   assign(tdchar_file, file_name);
   reset(tdchar_file);
   result := iores;
   IF result = 0 THEN
    BEGIN
     blockread(tdchar_file, buffer, 1, i); (* dummy block *)
     index := 64; (* force blockread in first read_word *)
     FOR i := 0 TO 31 DO 
      BEGIN
       dwaÆiÅ := '  ';
       dhaÆiÅ := @27'A  '@10@8@8'  ';
      END;
     dwaÆ10Å := @10   ; dwaÆ13Å := @13; dwaÆ8Å := @8@8; 
     dhaÆ10Å := @10@10; dhaÆ13Å := @13; dhaÆ8Å := @8@8;  
     FOR i := 32 TO 127 DO
      BEGIN
       dwaÆiÅ := CHAR(i) + CHAR(i+128);
       dhaÆiÅ := @27'A'  + rch  + rch  + @8@8@10 + rch + rch;
      END;
     fontÆ0Å := read_word;
     REPEAT
      FOR i := 1 TO 14 DO
       fontÆiÅ := read_word;
      define_alt_font(font);
      fontÆ0Å := read_word;
     UNTIL (fontÆ0Å = 0) OR (iores <> 0); 
     close(tdchar_file);
    END;
   init_double_char := result;
  (*$I+*)
 END; (* init_double_char *)

 

(* Programmet skriver en tekst med en given størrelse et givent sted  *)
(* på skærmen                                                         *)
(* N.C.Andersen  Frit efter Jørgen Sachariasen RC Århus               *)

(* programmet skal kaldes med mindst 7 parametre                      *)
(* 1:xkoordinat    2:ykoordinat    3:forgrundsfarve   4:baggrundsfarve*)
(* 5:størrelse     6:blink (1=ja 0=nej)   7: Mindst et ord tekst      *)
(* i hovedprogrammet skal includes tdchr*)

TYPE
 STR255 = STRINGÆ255Å;
 STR80  = STRINGÆ80Å; 

 VAR
  result       : INTEGER;
  antal,max    : INTEGER;
  file_name    : NAME;
  line         : STRINGÆ255Å;
  double_width : DWARRAY;
  double_size  : DHARRAY;
  
      stor     : INTEGER;
  ffarve,bfarve: CHAR;
  blink,test   : INTEGER; 
  
 FUNCTION monitor22khz: BOOLEAN;
 VAR
  regs: RECORD ax,bx,cx,dx,bp,si,di,ds,es,flags: INTEGER; END;
  nvm : ^BYTE;
 BEGIN
  regs.cx := 109;
  regs.dx :=   4;
  swint(224,regs); (* set console rawout *)
  regs.ax := 4;
  swint($28, regs);
  nvm := PTR(regs.es, regs.si + 18);
  monitor22khz := nvm^ >= 2;
 END;
     
 PROCEDURE writeblk(s: STR255);
 VAR
  regs: RECORD ax,bx,cx,dx,bp,si,di,ds,es,flags: INTEGER; END;
  s_blk:RECORD ssoff,sseg,ssize: INTEGER; END;
 BEGIN
  WITH s_blk DO
   BEGIN
    ssoff := OFS(sÆ1Å);
    sseg  := SEG(sÆ1Å);
    ssize := LEN(s);
    regs.cx := 111; (* c_writeblk *)
    regs.dx := OFS(s_blk);
    regs.ds := SEG(s_blk);
    swint(224, regs);
   END;
 END;

procedure init;
begin
  REPEAT
   IF monitor22khz THEN
    file_name := 'tdchr22.def'
   ELSE file_name := 'tdchr15.def'; 
   result := init_double_char(file_name, double_width, double_size);
   IF result <> 0 THEN
    writeln(@7@27'Q'@27'h', (*vælg standard tegnsæt+stop understregning*)
            'Fejl nr. ',result ,
            ' under indlæsning fra TELEDATA tegnsættet: ',
            file_name)
  UNTIL result = 0;
 end;
     
 procedure skriv(x,y:integer;ffarve,bfarve:char;stor,blink:integer;x7:str80);
 
 BEGIN  
 streng:='';
  for i:=1 to len(x7) do streng:=streng+x7(.i.)+' ';

  (*$I-*)
   n := 0;
GOTOXY(X,Y);
WRITE (@27'b',ffarve,@27'c',bfarve);
if (blink=1) THEN write (@27's');
              CASE stor OF
               0: BEGIN write(@27'Q'@27'h');         n := 0; END;
               1: BEGIN write(@27'P'@27'h');         n := 1; END;
               2: BEGIN write(@27'P'@27'g'@27@246);  n := 2; END;
              END;               
max:=len(streng);
antal:=0;
repeat
  begin;
  antal:=antal+1;
  ch:=copy(streng,antal,1);

        CASE stor OF
         0: writeblk(ch);
         1: writeblk(double_widthÆORD(ch)Å);
         2: writeblk(double_size ÆORD(ch)Å);
        END;
   end;
until antal=max;
write(@27'Q'@27'h'@27'b6'@27'c0');        
END; (*procedure skriv*)


(* Ud over ovenstående 2 programmer skal filerne tdchr22.def og tdchr15.def
   være på disketten *)
   
(*Herefter kan proceduren skriv kaldes med 7 parametre:
  1: x-koordinat for overskriftens start
  2: y-koordinat for overskriftens start
  3: tekstens forgrundsfarve
  4: tekstens baggrundsfarve
  5: tekstens størrelse (0-2)
  6: blink (1)   ingen blink (0)
  7: teksten
 *)
 
«eof»