program alpha;

{ STRIPPED DOWN VERSION FOR CHRIS WILKERSON }
{ for displaying the block alphabet for Chris }
{ written for Turbo Pascal}
{ uses terminal specific features
  1) gotoxy screen movement
  2) ClrScr
So you must use TINST to select ADM31 type terminal before
you can get a version to work on the Morrow.

I suggest you get it to work on kaypro first.

}

{ uses two font files alpha.chr and alpha.len that give
  table of raster data, and pointers to that data. It
  would be possible to incoporate this into the program,
  but I never got around to it.
}


{$R+}
{$C-}
type power = array[0..7] of byte;
     rownum = 0..23;
     colnum = 0..79;
     name =   string[25];


const
    NROWS = 23; { 0-23 }
    NCOLS = 79; { 0-79 }
    pow2 : power = (1,2,4,8,16,32,64,128);
    NUMCHR = $2000; { largest file of characters to read in }
    defaultpath= ''; (* change to your main drive if you want *)

type
    buf  = array[0..NUMCHR] of byte;
    ourscrn = array[0..NROWS,0..NCOLS] of boolean;
    virtscrn = ^ourscrn;
    bufptr = ^buf;
var
   valid, mode : boolean;
   maxrow,lomaxrow,currow : rownum;
   maxcol,lomaxcol,curcol:  colnum;
   gridmem  : virtscrn;
   ch,c,CURRCHR    :  char;
   i, oursize : integer;
   infile : file;
   inname : NAME;
   plen   : array[32..255] of colnum;
   poffset : array[32..255] of integer;
   pbuf  : bufptr;



{ we have 3 screens to contend with :
  1) The physical screen (24 x 80)
  2) the virtual screen in memory
  3) the window on the virtual screen
     that is actually displayed.
}

procedure locate(row,col : integer );
{ goes to a point on the physical screen }
begin
    gotoxy(col+1,row+1);  { reversed!!!, (1,1) is top left }
end ; { locate }


procedure ourlocate(row,col: integer); { locate on our own grid }
begin     {provide wraparound }
          locate(row,((NCOLS-maxcol) div 2)+col);
end; { our locate in the grid }

procedure home;
begin
    ourlocate(0,0);
    currow:=0;
    curcol:=0;
 end;


procedure setpt(row,col : integer);  { make a '#' mark }
begin
    ourlocate(row,col);
    write(CURRCHR);
    gridmem^[row,col]:=TRUE;
end; { setpt }

procedure resetpt(row,col : integer); { make a '.' }
begin
    gridmem^[row,col]:=FALSE;
end; { resetpt }

procedure drawgrid;
{ draw the grid using the data in gridmem }
var  i,j : byte;
begin
     for i:=0 to lomaxrow do begin
         for j:=0 to lomaxcol do begin
             if gridmem^[i,j] then setpt(i,j) else resetpt(i,j);
         end;
     end;
     home;
 end; { make grid }


procedure clrgrid;
var i,j : byte;
begin
     for i:=0 to lomaxrow do begin
         for j:=0 to lomaxcol do begin
             gridmem^[i,j]:=FALSE;
         end;
     end;
end; { clrgrid }


procedure newscr ; { erase screen and home cursor }
begin
    ClrScr;
end; { newscr }

procedure newpic;
begin
    newscr;
    drawgrid;
    home;
end;



function min( x,y : integer) : integer;
begin
     if x > y then min:=y else min:=x;
end;

procedure logo ; { what it does }
begin
   NEWSCR;
   LOCATE(12,0);
   WRITELN('                      ALPHABET AND NUMBER DRILL  ');
   WRITELN;
   WRITELN;
   WRITELN('                          Clarence Wilkerson   ');
   writeln;
   writeln('                                  9/84 ');
   WRITELN;
   WRITELN;writeln;
   WRITELN('>>>>>>       PRESS "A" for display mode, shows letter typed');
   writeln;
   writeln('             PRESS "R" for random test of lower case characters.');
   writeln('                Child types letter to proceed. Six tries allowed.');
   writeln;
   writeln('             Use ^A (CTRL-A) to toggle modes.');
   writeln;
   writeln('             Use ^C (CTRL-C) to exit. Your choice? ..  ');
   delay(1000);
end;

procedure convert; { take length table and make an offset table }
var sum,i : integer;
begin
    sum:=0;
    for i:=32 to 127 do begin
       poffset[i]:=sum; { runs one position behind }
       sum:=sum+3*plen[i]; { plen is in terms of vertical bars, so mult by 3}
    end; {i}
 end;{convert}

procedure flushkbd; { get rid of characters typed after the displayed one }
var c : char;
begin
  while keypressed do  read(kbd,c);
  { gobble up queue of characters typed }
end;


FUNCTION fetch(auto: BOOLEAN) : integer;
 { get character from compressed form in memory, put on screen }
var c : char;
    x,i,j,k : integer;
    y,u,s : integer;
begin

 if not auto then begin { get and filter the choice of letter }
    locate(1,1); write('Character? ');
    read(KBD,c);
    if ( ord(c) > 31) and ( ord(c) < 127) then write(c);
    delay(500); { delay a bit to display choice before clearing screen }
    if c = chr(3) then fetch:=0
    else if c = chr(1) then fetch:=-1
    else begin
       fetch:=1;
       x:=ord(c);
       if ( x > 127) or (x < 32) then begin
         c:='.';
         x:=46;
       end; { make it an period }
 end;
 end else if auto then begin
     x:=0;
     while x < 97 do x:=random(123); { lowercase only }
     c:=chr(x);
 end;

     currchr:=c; { make the display in terms of the character }
     if plen[x]=0 then lomaxcol:=0 else lomaxcol:=plen[x]-1; { get the length }
     { now read 3 bytes for each vertical bar }
     lomaxcol:=min(lomaxcol,maxcol);

     for j:=0 to lomaxcol do begin  { all columns }
       for k:=0 to 2 do begin  { 3 bars per column }
          y:= poffset[x]+k+(3*j); { i is gotten by ANDING }
          for i:=0 to 7 do begin { all rows }
             s:=(k*8) +i;
             gridmem^[s,j]:=(pbuf^[y] and pow2[7-i] <> 0);
          end; {i}
    end; { k }
   end; { j }
   newpic;
   if not auto then begin
       DELAY(1500); { KEEP THE PICTURE ON SCREEN FOR A WHILE }
       flushkbd; { empty the queue of kbd characters to eliminate typeahead }
    end
   else if auto then begin
      locate(4,50);
      writeln(chr(7),'Type the matching letter.');
      flushkbd;
      c:=' ';
      i:=0;
      while ( c <> currchr) and ( i < 6 ) do begin
         i:=i+1;
         locate(5 + i,50);
         write(chr(7),i,') ');
         read(kbd,c);writeln(c);
         if c = chr(3) then halt;
         if c = chr(1) then begin
             i:=100;  { to force exit }
             fetch :=-1; { to switch modes }
         end; { if c = chr(1) }
      end; { while c <> }
   end; { if auto }

  home;
 end; { fetch }

procedure getinput( S : NAME); { open an input file }
var valid : boolean;  { tries to open file s, if cannot, asks for new name }
begin
     inname:=s;
     REPEAT
        assign(infile,inname);
        {$I-}
        reset(infile);
        valid:=(ioresult=0);
        {$I+}
        if not valid then begin
            inname:=defaultpath + inname;
            assign(infile,inname);
            {$I-}
            reset(infile);
            valid:=(ioresult=0);
            {$I+}
            if not valid then begin
                 write('File ',inname,' not found. Replacement? ');
                 readln(inname);
            end;
        end;
        writeln;
     UNTIL VALID ;
end; { getinput }

begin { main }
      newscr;
      logo;
      readln(ch);
      ch:=upcase(ch);
      new(gridmem);
      if gridmem = nil then writeln('Warning. Overflow on gridmem.');
      new(pbuf);  { allocate the big stuff at run time }
      if pbuf = nil then writeln('Warning. Overflow on pbuf.');
      { clean file buffer area }
      fillchar(pbuf^,Numchr,0);
      for i:=0 to NUMCHR do pbuf^[i]:=0;
      getinput('ALPHA.LEN');    { CHANGE DEFAULT DIRECTORY }
      blockread(infile,plen[32],1); { 1 sector file }
      close(infile);
      convert;   { change plen data to poffset data }
      writeln;
      getinput('ALPHA.CHR');
      oursize:=filesize(infile);
      if oursize < (NUMCHR div 128) then blockread(infile,pbuf^[0],oursize)
       else blockread(infile,pbuf^[0],(NUMCHR div 128));
      close(infile);
      maxrow:=23;
      maxcol:=45;
      lomaxrow:=maxrow;
      lomaxcol:=maxcol;
      clrgrid;
      newpic;
      home;
      { begin with the indicated mode }
      valid:=true;
      if ch = 'R' then begin
            mode:=TRUE;
            gotoxy(1,1);writeln('Random Test Mode. Type character to continue.');
            delay(500);
      end
      else begin
            mode:=False;
            gotoxy(1,1);writeln('Display Mode. Shows character typed.');
            delay(500);
      end;

      while valid do begin
          i:= FETCH(mode);
          if i = 0 then valid:=false;
          if i = -1 then { switch modes } begin
               gotoxy(1,1);
               writeln('Switching modes.');
               mode:= not mode;
               delay(500);
          end;
     end;
   newscr;
end.