HPAVC/HPAVC CD-ROM.iso/pc/FGFDEMO.ZIP/FGFDEMO.PAS

Pascal/Delphi Source File | 1993-07-17 | 17.8 KB | 646 lines

{*****************************************************************************
*                                                                            *
*  FGFDEMO.PAS                                                               *
*                                                                            *
*  This program demonstrates some features of Fastgraph/Fonts.               *
*                                                                            *
*  Fastgraph/Fonts lets you easily add bit-mapped font support to Fastgraph  *
*  or Fastgraph/Light applications.                                          *
*                                                                            *
*  Copyright (c) 1992-1993 Ted Gruber Software.  All Rights Reserved.        *
*                                                                            *
*                                                                            *
*  Ted Gruber Software would like to acknowledge the contributions made by   *
*  Randall Dryburgh of Micron Software Sciences in creating FGFDEMO.  Randy  *
*  developed the original versions of the functions relating to the palette  *
*  fades and the digital odometer.                                           *
*                                                                            *
*****************************************************************************}

{$M 16384,0,16384}

program main;
uses fgmain, fgmisc, fgpcx, fgf;

const

  NFONTS = 11;
  NPALETTES = 16;
  NSTEPS = 32;

  LEFT   = -1;
  CENTER =  0;
  RIGHT  =  1;
  TOP    =  1;
  BOTTOM = -1;

  { font names }

  fontname : array [1..NFONTS] of string = (
    'Austin 36',
    'Broadway 18',
    'Cognac 19',
    'Crystal 14',
    'Crystal 26',
    'Fountain 27',
    'Modern 28',
    'Plaza 14',
    'Regal 24',
    'Royal 15',
    'Standard 8');

var

  { font handles }

  austin, broadway, cognac, crystal14, crystal26, fountain, modern : integer;
  plaza, regal, royal, standard : integer;

  { other globals }

  clockspeed : longint;

  default_palette, new_palette, zeroes : array [1..NPALETTES*3] of shortint;
  average : array [1..NPALETTES*3] of real;

{*****************************************************************************
*                                                                            *
*  average_palette                                                           *
*                                                                            *
*  Compute the palette fade increments used by fade_in and fade_out.         *
*                                                                            *
*****************************************************************************}

procedure average_palette;

var

  i : integer;

begin

  for i := 1 to NPALETTES*3 do
    average[i] := default_palette[i] / NSTEPS;

end;

{*****************************************************************************
*                                                                            *
*  fade_in                                                                   *
*                                                                            *
*  Fade one or more DACs from black to their target colors.                  *
*                                                                            *
*****************************************************************************}

procedure fade_in (start, count : integer);

var

  i, j, k, n : integer;
  last : integer;
  factor : real;

begin

  last := start + count - 1;

  for i := 1 to NSTEPS do
  begin
    factor := i;
    k := 1;
    n := start * 3 + 1;
    for j := start to last do
    begin
      new_palette[k] := trunc(average[n] * factor);
      inc(k); inc(n);
      new_palette[k] := trunc(average[n] * factor);
      inc(k); inc(n);
      new_palette[k] := trunc(average[n] * factor);
      inc(k); inc(n);
    end;
    fg_setdacs(start,count,new_palette);
    fg_waitfor(1);
  end;

end;

{*****************************************************************************
*                                                                            *
*  fade_out                                                                  *
*                                                                            *
*  Fade one or more DACs from their current colors to black.                 *
*                                                                            *
*****************************************************************************}

procedure fade_out (start, count : integer);

var

  i, j, k, n : integer;
  last : integer;
  factor : real;

begin

  last := start + count - 1;

  for i := 1 to NSTEPS do
  begin
    factor := i;
    k := 1;
    n := start * 3 + 1;
    for j := start to last do
    begin
      new_palette[k] := default_palette[n] - trunc(average[n] * factor);
      inc(k); inc(n);
      new_palette[k] := default_palette[n] - trunc(average[n] * factor);
      inc(k); inc(n);
      new_palette[k] := default_palette[n] - trunc(average[n] * factor);
      inc(k); inc(n);
    end;
    fg_setdacs(start,count,new_palette);
    fg_waitfor(1);
  end;

end;

{*****************************************************************************
*                                                                            *
*  widest_numeral                                                            *
*                                                                            *
*  Compute the width of the widest digit in the current font.                *
*                                                                            *
*****************************************************************************}

function widest_numeral : integer;

var

  widest, width : integer;
  c : integer;

begin

  widest := 0;
  for c := ord('0') to ord('9') do
  begin
    width := fgf_width(chr(c),1);
    if (width > widest) then widest := width;
  end;

  widest_numeral := width;

end;

{*****************************************************************************
*                                                                            *
*  odometer                                                                  *
*                                                                            *
*  Increment the odometer amount by one cent and scroll its new amount on    *
*  the screen.                                                               *
*                                                                            *
*****************************************************************************}

procedure odometer (x, y : integer; amount : real;
                    foreground_color, background_color : integer);

var

  i, j : integer;
  char_width : integer;
  delay_diff, delay_same : integer;
  height, width : integer;
  length_old, length_new : integer;
  xpos : integer;
  amount_old, amount_new : string[8];

begin

  { create strings for old and new amounts }

  str(amount:7:2,amount_old);
  str(amount+0.01:7:2,amount_new);
  length_old := length(amount_old);
  length_new := length(amount_new);

  { get height of the amount string }

  height := fgf_height(amount_old,length_old);

  { get its width, rounded up to a byte boundary multiple }

  width := (widest_numeral + 7) and $FFF8;

  { create a box in the background color }

  fg_setpage(1);
  fg_setcolor(background_color);
  fg_rect(200,200+width*length_new,100-height,100+height);
  fg_setcolor(foreground_color);
  fgf_justify(LEFT,BOTTOM);

  { put old amount on hidden video page }

  for i := 1 to length_old do
  begin
    char_width := (width - fgf_width(amount_old[i],1)) div 2;
    fg_move(200+(i-1)*width+char_width,100);
    fgf_print(amount_old[i],1);
  end;

  { put new amount on hidden video page }

  for i := 1 to length_new do
  begin
    char_width := (width - fgf_width(amount_new[i],1)) div 2;
    fg_move(200+(i-1)*width+char_width,100+height);
    fgf_print(amount_new[i],1);
  end;

  { copy old amount to visual video page }

  fg_transfer(200,200+width*length_old,100-height,100,x,y,1,0);

  { roll the odometer }

  delay_diff := (clockspeed div 60) div length_new;
  delay_same := (clockspeed div 10) div length_new;

  for j := 1 to height do
  begin
    for i := 1 to length_new do
    begin
      if (amount_new[i] <> amount_old[i]) and (amount_old[i] <> '.') then
      begin
        fg_stall(delay_diff);
        xpos := 200 + (i-1) * width;
        fg_transfer(xpos,xpos+width,100+(j-1)-height,100+(j-1),x+xpos-200,y,1,0);
      end
      else
        fg_stall(delay_same);
    end;
  end;

end;

{*****************************************************************************
*                                                                            *
*  main program                                                              *
*                                                                            *
*****************************************************************************}

var

  i : integer;
  abort : boolean;
  old_mode : integer;
  status : integer;
  width : integer;
  x, y : integer;
  amount : real;
  key, aux : byte;
  cc : string[1];
  message : string[24];

begin

  { make sure we're running on a VGA system; exit if not }

  if (fg_testmode(18,0) = 0) then
  begin
    writeln('This demo requires 640 x 480 16 color VGA graphics.');
    exit;
  end;

  { load the font files }

  austin    := fgf_load('AUSTIN36.FGF'+chr(0));
  broadway  := fgf_load('BRODWY18.FGF'+chr(0));
  cognac    := fgf_load('COGNAC19.FGF'+chr(0));
  crystal14 := fgf_load('CRYSTL14.FGF'+chr(0));
  crystal26 := fgf_load('CRYSTL26.FGF'+chr(0));
  fountain  := fgf_load('FOUNTN27.FGF'+chr(0));
  modern    := fgf_load('MODERN28.FGF'+chr(0));
  plaza     := fgf_load('PLAZA14.FGF'+chr(0));
  regal     := fgf_load('REGAL24.FGF'+chr(0));
  royal     := fgf_load('ROYAL15.FGF'+chr(0));
  standard  := fgf_load('STNDRD08.FGF'+chr(0));

  { verify all fonts were loaded successfully; exit if not }

  abort := false;
  if (austin = 0) then abort := true;
  if (broadway = 0) then abort := true;
  if (cognac = 0) then abort := true;
  if (crystal14 = 0) then abort := true;
  if (crystal26 = 0) then abort := true;
  if (fountain = 0) then abort := true;
  if (modern = 0) then abort := true;
  if (plaza = 0) then abort := true;
  if (regal = 0) then abort := true;
  if (royal = 0) then abort := true;
  if (standard = 0) then abort := true;
  if (abort) then
  begin
     writeln('Failure loading one or more font files.');
     exit;
  end;

  { benchmark the system speed }

  clockspeed := fg_measure;

  { initialize the array that zeroes the DAC values }

  for i := 1 to NPALETTES*3 do
    zeroes[i] := 0;

  { initialize Fastgraph's video environment }

  old_mode := fg_getmode;
  fg_setmode(18);
  fg_getdacs(0,NPALETTES,default_palette);

  { create palette increment averages }

  average_palette;

  { draw the TGS logo on the hidden page }

  fg_setpage(1);
  status := fg_showpcx('TGS.PCX'+chr(0),0);

  { fade in the TGS logo on the visual page }

  fg_setdacs(0,NPALETTES,zeroes);
  fg_transfer(0,185,0,89,227,285,1,0);
  fade_in(0,16);

  { fade in "and" }

  fg_setpage(0);
  fg_setrgb(15,0,0,0);
  fgf_select(standard);
  fg_setcolor(15);
  fg_move(320,315);
  fgf_justify(CENTER,CENTER);
  fgf_print('and',3);
  fade_in(15,1);

  { fade out the visual page }

  fg_waitfor(30);
  fade_out(0,16);

  { erase both pages }

  fg_setpage(0);
  fg_erase;
  fg_setpage(1);
  fg_erase;

  { draw the Micron logo on the hidden page }

  fg_move(0,0);
  status := fg_showpcx('MICRON.PCX'+chr(0),2);

  { fade in the Micron logo on the visual page }

  fg_setdacs(0,NPALETTES,zeroes);
  fg_transfer(0,165,0,52,237,266,1,0);
  fade_in(0,16);

  { fade in "present" }

  fg_setpage(0);
  fg_setrgb(14,0,0,0);
  fg_setcolor(14);
  fg_move(320,315);
  fgf_print('present',7);
  fade_in(14,1);

  { fade to black }

  fg_waitfor(30);
  fade_out(0,16);

  { erase both pages }

  fg_setpage(0);
  fg_erase;
  fg_setpage(1);
  fg_erase;

  { display and then fade out the Fastgraph/Fonts logo }

  fg_setpage(0);
  fgf_select(austin);
  fg_setcolor(10);
  fg_move(320,240);
  fgf_justify(CENTER,BOTTOM);
  fgf_print('Fastgraph/Fonts',15);
  fgf_select(crystal14);
  fg_setcolor(15);
  fg_move(320,270);
  fgf_justify(CENTER,CENTER);
  fgf_print('Copyright (c) 1992-1993 Ted Gruber Software',43);
  fg_move(320,286);
  fgf_print('All Rights Reserved.',20);
  fade_in(10,1);
  fg_waitfor(18);
  fade_in(15,1);
  fg_waitfor(30);
  fade_out(0,16);

  { display the info screen }

  fg_setpage(0);
  fg_erase;

  fgf_select(regal);
  fg_setcolor(10);
  fg_box(0,639,0,479);
  fg_move(0,32);
  fg_draw(639,32);
  fg_move(320,5);
  fgf_justify(CENTER,TOP);
  fgf_print('Fastgraph/Fonts',15);

  fgf_select(modern);
  fg_setcolor(12);
  fg_move(320,60);
  fgf_justify(CENTER,CENTER);
  fgf_print('Fastgraph/Fonts'+chr(127)+chr(9)+' lets you easily add bit-mapped',48);
  fg_move(320,90);
  fgf_print('character support to Fastgraph applications.  It',48);
  fg_move(320,120);
  fgf_print('includes a wide range of fonts in several point sizes.',54);
  fg_move(320,150);
  fgf_print('An application can load up to 32 fonts at once.',47);

  fgf_select(broadway);
  fg_setcolor(12);
  fg_move(320,190);
  fgf_print('Fastgraph/Fonts'+chr(127)+chr(15)+' includes functions for font loading',53);
  fg_move(320,215);
  fgf_print('and unloading, string display with horizontal and',49);
  fg_move(320,240);
  fgf_print('vertical justification, font selection, determining',51);
  fg_move(320,265);
  fgf_print('string height and width, and other useful features.',51);
  fg_move(320,290);
  fgf_print('Font files that come with Fastgraph/Fonts may be',48);
  fg_move(320,315);
  fgf_print('distributed freely as part of your applications.',48);

  fgf_select(fountain);
  fg_setcolor(9);
  fg_move(320,355);
  fgf_print('The '+chr(127)+chr(12)+'Fastgraph/Fonts User''s Guide'+chr(127)+chr(9)+' includes a',47);
  fg_move(320,385);
  fgf_print('description of the font file format, so you can',47);
  fg_move(320,415);
  fgf_print('create your own font files in case Fastgraph/Fonts',50);
  fg_move(320,445);
  fgf_print('doesn''t include your favorite fonts.',36);

  fade_in(0,16);
  fg_waitkey;
  fade_out(0,16);
  fg_erase;

  { display the features screen }

  fgf_select(cognac);
  fg_setcolor(14);
  fg_move(320,240);
  fgf_print('...and now to demonstrate some Fastgraph/Fonts features...',58);
  fade_in(14,1);
  fg_waitfor(30);
  fade_out(14,1);
  fg_setcolor(1);
  fg_setpage(1);
  fg_rect(0,639,0,319);
  fg_setpage(0);
  fg_rect(0,639,0,479);
  fg_setdacs(0,NPALETTES,default_palette);

  fgf_select(crystal26);
  fg_setcolor(15);
  fg_move(320,50);
  fgf_justify(CENTER,BOTTOM);
  fgf_print('Load up to 32 fonts at once!',28);

  fgf_select(crystal26);
  fg_setcolor(4);
  fg_move(240,90);
  fgf_print('Jackpot is $ ',13);
  x := fg_getxpos;
  y := fg_getypos;

  fgf_select(broadway);
  fg_setcolor(2);
  fg_move(320,120);
  cc := chr(127);
  fgf_print('Change '+cc+chr(3)+'colors '+cc+chr(4)+'anywhere '+cc+chr(5)+'in '+cc+chr(6)+'a '+cc+chr(7)+'string',44);

  fgf_select(royal);
  fg_setcolor(14);
  fg_move(320,160);
  fgf_print('Justify strings horizontally and vertically:',44);
  fg_setcolor(7);
  fg_move(0,180);
  fg_dash(639,180,$1111);
  fg_setcolor(14);
  fg_move(0,180);
  fgf_justify(LEFT,BOTTOM);
  fgf_print('LEFT AND ABOVE',14);
  fg_move(320,180);
  fgf_justify(CENTER,CENTER);
  fgf_print('CENTERED BOTH DIRECTIONS',24);
  fg_move(639,180);
  fgf_justify(RIGHT,TOP);
  fgf_print('RIGHT AND BELOW',15);

  fgf_select(modern);
  fg_setcolor(12);
  fg_move(320,220);
  width := fgf_width(' ',1);
  fgf_space(width div 2);
  fgf_justify(CENTER,CENTER);
  fgf_print('narrow spacing between words',28);
  fg_move(320,250);
  fgf_space(width);
  fgf_print('normal spacing between words',28);
  fg_move(320,280);
  fgf_space(width*2);
  fgf_print('wide spacing between words',26);

  repeat
     fg_intkey(key,aux);
  until (key+aux = 0);

  fgf_select(crystal26);
  fg_setcolor(4);
  amount := 1998.31;
  repeat
  begin
    odometer(x,y,amount,4,1);
    amount := amount + 0.01;
    fg_intkey(key,aux);
  end;
  until (key+aux > 0) or (amount >= 10000.00);

  { cast of characters screen }

  fg_setpage(0);
  fg_erase;
  fgf_select(regal);
  fg_setcolor(10);
  fg_move(320,0);
  fgf_justify(CENTER,TOP);
  fgf_print('*** Partial Cast of Characters ***',34);

  message := 'ABCDabcd1234.,?!+-&@#$';
  y := 80;

  for i := 1 to NFONTS do
  begin
    fgf_select(i);
    fg_setcolor(i);
    fg_move(20,y);
    fgf_justify(LEFT,BOTTOM);
    fgf_print(fontname[i],length(fontname[i]));
    fg_move(620,y);
    fgf_justify(RIGHT,BOTTOM);
    fgf_print(message,22);
    y := y + 36;
  end;

  fg_setcolor(10);
  fg_move(320,y);
  fgf_justify(CENTER,BOTTOM);
  fgf_print('and many more!',14);

  fg_waitkey;
  fade_out(0,16);

  { unload fonts and restore the original video state before exiting }

  fgf_unload(-1);
  fg_setmode(old_mode);
  fg_reset;

  { display ordering information }

  writeln('Fastgraph/Fonts (tm) is available for $49 from:');
  writeln;
  writeln('Ted Gruber Software     orders/info [phone]');
  writeln('PO Box 13408                    FAX [phone]');
  writeln('Las Vegas, NV  89112            BBS [phone]');
  writeln;
  writeln('Please add $3 shipping within the U.S. and Canada,');
  writeln('or $6 to other countries.');

end.