home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / FLASHEQ.ZIP / FLASH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-09-08  |  3.2 KB  |  141 lines
  1. { FLASH.PAS (C) Copyright 1985 by Bill Hileman
  2.  
  3.   The following routines are released to the Public Domain to be used
  4.   in programs and/or be distributed free of charge, provided that they
  5.   are distributed in their original form, and including this copyright
  6.   notice.
  7.  
  8.   Version 1.00  09/08/85
  9.  
  10.   Program to demonstrate use of FLASH.INC include file routines        }
  11.  
  12. program flash;
  13.  
  14. const
  15.   version = '1.00';
  16.   v_date  = '09/08/85';
  17.  
  18. var
  19.   org_c_start,
  20.   org_c_end,
  21.   equip_flag,
  22.   printers,
  23.   rs_232s,
  24.   floppies, ram : integer;
  25.   mono, color,
  26.   game_adapt,
  27.   dma_chip,
  28.   flop          : boolean;
  29.  
  30. {$I flash.inc }
  31.  
  32. procedure press_enter;
  33.  
  34. var
  35.   ch   : char;
  36.   done : boolean;
  37.  
  38. begin
  39.   done:=false;
  40.   repeat
  41.     repeat until keypressed;
  42.     read(kbd,ch);
  43.     if ch=chr(13) then
  44.       done:=true;
  45.   until done;
  46. end;
  47.  
  48. begin
  49.   get_cursor_size(org_c_start,org_c_end);
  50.   set_cursor_size(32,0); { off }
  51.   equip_flag:=get_equip_flag;
  52.   printers:=(equip_flag shr 14);
  53.   game_adapt:=((equip_flag and $1000)=$1000);
  54.   rs_232s:=((equip_flag shr 9) and $0007);
  55.   dma_chip:=((equip_flag and $0100)=$0100);
  56.   floppies:=((equip_flag shr 6) and $0003)+1;
  57.   mono:=((equip_flag and $0300)=$0300);
  58.   color:=(not mono);
  59.   flop:=((equip_flag and $0001)=$0001);
  60.   ram:=get_installed_ram;
  61.   clrscr;
  62.   textcolor(white+blink);
  63.   textbackground(black);
  64.   write  ('FLASH');
  65.   if mono then
  66.     textcolor(white)
  67.   else
  68.     textcolor(blue);
  69.   writeln(' - (C) Copyright 1985 by Bill Hileman');
  70.   writeln('        Version ',version,'  ',v_date);
  71.   writeln;
  72.   if color then
  73.     textcolor(red);
  74.   writeln('Demonstrates the capabilities of the functions');
  75.   writeln('and procedures contained in ''FLASH.INC''.');
  76.   writeln;
  77.   if color then
  78.     textcolor(cyan);
  79.   writeln('Current hardware configuration:');
  80.   writeln;
  81.   writeln('       Installed RAM: ',ram:3,'k');
  82.   write  ('               Video: ');
  83.   if mono then
  84.     writeln('monochrome')
  85.   else
  86.     writeln('color');
  87.   write  ('  Printers attatched: ');
  88.   if (printers>0) then
  89.     writeln(printers:1)
  90.   else
  91.     writeln('none');
  92.   write  ('  Floppy Disk Drives: ');
  93.   if flop then
  94.     writeln(floppies:1)
  95.   else
  96.     writeln('none');
  97.   write  ('        Game Adapter: ');
  98.   if (not game_adapt) then
  99.     write('not ');
  100.   writeln('installed');
  101.   write  ('RS232 (serial) Ports: ');
  102.   if (rs_232s>0) then
  103.     writeln(rs_232s:1)
  104.   else
  105.     writeln('none');
  106.   write  ('            DMA Chip: ');
  107.   if (not dma_chip) then
  108.     write('not ');
  109.   writeln('installed');
  110.   writeln;
  111.   if color then
  112.     textcolor (magenta);
  113.   write('Block cursor - Press [ENTER] < >',#8,#8);
  114.   if mono then
  115.     set_cursor_size(0,13)
  116.   else
  117.     set_cursor_size(0,7);
  118.   press_enter;
  119.   writeln;
  120.   writeln;
  121.   if color then
  122.     textcolor(yellow);
  123.   write('  Bar cursor - Press [ENTER] < >',#8,#8);
  124.   if mono then
  125.     set_cursor_size(12,13)
  126.   else
  127.     set_cursor_size(6,7);
  128.   press_enter;
  129.   writeln;
  130.   writeln;
  131.   if color then
  132.     textcolor(green);
  133.   write('   No cursor - Press [ENTER] < >',#8,#8);
  134.   set_cursor_size(32,0);
  135.   press_enter;
  136.   writeln;
  137.   if color then
  138.     textcolor(white);
  139.   set_cursor_size(org_c_start,org_c_end);
  140. end.
  141.