home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / microcrn / issue_40.arc / SCANNER.ARC / PIC2FILE.MOD < prev    next >
Text File  |  1988-01-11  |  3KB  |  65 lines
  1. (* Code from Pascal column in Micro Cornucopia Issue #40 *)
  2.  
  3. MODULE Pic2File;
  4. (* Capture an image to a file as well as displaying it *)
  5.  
  6. FROM ScrnStuff IMPORT Screen, ClrScr, GraphMode, TextMode, Scan, 
  7.                       PixAddress, Buffer, SetBit, SetClock, ClrBit;
  8. FROM Terminal IMPORT KeyPressed, ReadString, WriteString;
  9. FROM Config IMPORT Xsize, Ysize;
  10. FROM FileSystem IMPORT File, Lookup, WriteNBytes, Close;
  11. FROM SYSTEM IMPORT SIZE, ADR;
  12.  
  13. CONST
  14.    TickSize = 1536;      (* real time clock chip divisor, this value gave
  15.                             reasonable results.  Subject to change. *)
  16.    packsize = Xsize DIV 2 -1;
  17. VAR
  18.    S [0b000h:0] : Screen; (* use appropriate constants for your adapter *)
  19.    I, J, K, L : CARDINAL;
  20.    B : Buffer;
  21.    A : POINTER TO CHAR;
  22.    BP : CARDINAL;          (* not used except as throwaway parameter *)
  23.    ch : CHAR;
  24.    byteArray : ARRAY [0..packsize] OF CHAR;
  25.    byteidx, w : CARDINAL;
  26.    f : File;
  27.    fname : ARRAY [0..40] OF CHAR;
  28.  
  29. BEGIN
  30.    ClrScr(S);              (* clear the screen *)
  31.    WriteString('Name of picture data file: ');
  32.    ReadString(fname);
  33.    GraphMode;              (* put it in graphics mode *)
  34.    Lookup(f,fname,TRUE);   (* open/create file function *)
  35.    SetClock(TickSize);
  36.    FOR J := 0 TO Ysize-1 DO   (* for now, just try for same resolution as screen *)
  37.       byteidx := 0;
  38.       Scan(B);                (* capture a line od data *)
  39.       FOR K := 0 TO Xsize-1 BY 8 DO   (* Xsize is bits, do a byte at a time *)
  40.          A := PixAddress(K,J,BP);     (* calculate byte address *)
  41. (*==>*)  ch := CHR(255);              (* clear assembly variable *)
  42.        (*ch := CHR(0);                (* to get white on black *)*)
  43.          FOR L := 0 TO 7 DO           (* then do each bit in the byte *)
  44.             IF ODD(K+L) THEN
  45.                byteArray[byteidx] := CHR(ORD(byteArray[byteidx]) + 
  46.                                          ORD(B[K+L]));
  47.                INC(byteidx);
  48.             ELSE
  49.                byteArray[byteidx] := CHR(ORD(B[K+L]) * 16);
  50.             END;
  51. (*==>*)     IF B[K+L] < 17C THEN
  52.                ch := ClrBit(ch,7-L);
  53.              (*ch := SetBit(ch,7-L);  (* to get white on black *)*)
  54.                END;
  55.             END;
  56.          A^ := ch;             (* actual screen byte update here *)
  57.          END;
  58.       WriteNBytes(f,ADR(byteArray),SIZE(byteArray),w);
  59.       END;
  60.    Close(f);
  61.    WHILE NOT(KeyPressed()) DO END;    (* admire the picture for a bit *)
  62.    ClrScr(S);                         (* then do orderly exit *)
  63.    TextMode;                          (* should also SlowClock *)
  64. END Pic2File.
  65.